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FOREWORD 


This report presents results of the expansion and improvement of the 
FORMA system for response and load analysis. The acronym FORMA stands 
for FORTRAN Matrix Analysis. The study, performed from 16 May 1975 
through 17 May 1976 was conducted by the Analytical Mechanics Department, 
Martin Marietta Corporation, Denver Division, under the contract NAS8-* 
31376. The program was administered by the National Aeronautics and 
Space Administration, George C. Marshall Space Flight Center, Huntsville, 
Alabama under the direction of Dr. John R. Admire, Structural Dynamics 
Division, Systems Dynamics Laboratory. 

This report is published in seven volumes: 

Volume I - Programming Manual, 

Volume IIA - Listings, Dense FORMA Subroutines, 

Volume IIB - Listings, Sparse FORMA Subroutines, 

Volume lie - Listings, Finite Element FORMA Subroutines, 

Volume IIIA - Explanations, Dense FORMA Subroutines, 

Volume IIIB - Explanations, Sparse FORMA Subroutines, and 
Volume me - Explanations, Finite Element FORMA Subroutines. 
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ABSTRACT 


This report presents techniques for the solution of structural 
dynamic systems on an electronic digital computer using FORMA (FORT RAN 
^trix ^alysis) . 

FORMA is a library of subroutines coded in FORTRAN IV for the effi- 
cient solution of structural dynamics problems. These subroutines are 
in the form of building blocks that can be put together to solve a large 
variety of structural dynamics problems. The obvious advantage of the 
building block approach is that programming and checkout time are limi- 
ted to that required for putting the blocks together in the proper order 

The FORMA method has advantageous features such as: 

1. subroutines in the library have been used extensively for many 
years and as a result are well checked out and debugged; 

2. method will work on any computer with a FORTRAN IV compiler; 

3* incorporation of new subroutines is no problem; 

4. basic FORTRAN statements may be used to give extreme flexi- 
bility in writing a program. 


Two programming techniques are used in FORMA: dense and sparse. 
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I. INTRODUCTION 


A listing of the source deck of each dense FORMA subroutine is 
given in this volume to remove the **b lack- box" aura of the subroutines 
so that the analyst may better understand the detail operations of each 
subroutine . 

The FORTRAN IV programming language is used throughout, with the 
exception of MSFC UNIVAC 1108 systems subroutines used in FORMA sub- 
routines START, PLOTl, PL0T2, PL0T3 and ZZBOMB- 
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II. SUBROUTINE LISTINGS 


The subroutines are given in alphabetical order with numbers 
coming before letters. 



AAPB 


SUBROUTINE AABB ( ALPHA t At BETA tBfZtNR,NC »KR| 

DIMENSION A(KR»l)t BIKRtDt Z(KRtl) 

C 

C MATRIX SUMMATION. (ALPHA ♦A ♦ BETA ♦ B = Z). 

C MATRICES A,Z OR B,Z MAY SHARE SAME CORE LOCATIONS. 

C CODED BY RL WOHLEN. FEBRUARY 1965. 

C 

C SUBROUTINE ARGUMENTS 

C ALPHA = INPUT SCALAR. 

C A = INPUT MATRIX. SIZE(NR,NCI. 

C BETA = INPUT SCALAR. 

C B = INPUT MATRIX. S1ZE(NR,NCI. 

C 2 = OUTPUT RESULT MATRIX. SIZE(NR,NCI. 

C NR = INPUT NUMBER OF ROWS IN MATRICES A*B,Z. 

C NC = INPUT NUMBER OF COLS IN MATRICES A«B»Z. 

C KR = INPUT ROW DIMENSION OF A,B,Z IN CALLING PROGRAM. 

C 


DO 10 1=1 ,NR 
DO 10 J=lfNC 

10 Z(I,J) = ALPHA*A(I,JI ♦ BETA*B(I,J» 
RETURN 
END 
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C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


SUBROUTINE ABU A ,B, Z, NRA,NCA,NCBfKRAf KRBtKRZ) 
DIMENSION A(KRA,1 J,P(KRB,1I .ZCKRZ,!) 

COMMON / LWRKVl / V 1500 1 
DOUBLE PRECISION SUMySS.ZERO 
DATA ZERO /O.D/ 

ABl PERFORMS THE MATRIX OPERATION CZI^IAI^CBI • 
ABl CAN ALSO PERFORM THE OPERATIONS 
IZI=(A)*(AI BY CALL AB1(A«A*Z* — ETC — » 
(A)=(AI*IB) BY CALL AB1(A»B,A, — ETC — » 

IF NRA IS NEGATIVE AND ABS(NRA) IS EOUAL TO NCB 
A SQUARE, SYMMETRIC IZ| IS CALCULATED. 

MAXIMUM SIZE NCA=500 


INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

FORMA SUBROUTINE ZZBOMB IS CALLED . 

CODED BY JOHN ADMIRE *NASA* JULY 1972 . 

LAST REVISION BY RL WOHLEN. MARCH 1976. 


A 

— 

INPUT 

e 

— 

INPUT 

z 

— 

OUTPUT 

NRA 

— 

INPUT 

NCA 

- 

INPUT 

NCB 

- 

INPUT 

KRA 

— 

INPUT 

KRB 


INPUT 

KRZ 

— 

INPUT 


ARGUMENTS 

MATRIX (Al SIZECNRA BY NCA) 

MATRIX CP) SIZECNCA BY NCB) 

MATRIX CZ) SIZECNRA BY NCB) 

ABSCNRA) IS THE NUMBER OF ROWS IN 
NUMBER OF COLUMNS IN fA) 

NUMBER OF COLUMNS IN 
ROW DIMENSION OF CA) 

ROW DIMENSION OF CB) 

ROW DIMENSION OF CZ) 


CP) 

IN CALLING 
IN CALLINC 
IN CALLING 


(A) 


PROGRAM 

PROGRAM 

PROGRAM 


NERROR EXPLANATIONS 

1 = SIZF EXCEEDANCE. 

2 = NON-SQUARE RESULT ASKED FOR. 


NR=IABSCNRA) 


IFCNCA .GT. 500 .OR. NR .GT. KRA .OR. NCA .GT. KRB 
* .OR. NR .GT. KRZ) GO TO 999 
IFCNRA .GT. 0) GO TO 40 


IFCNR .NE. NCB) GO TO 999 
DO 30 1=1, NR 
DO 10 K=1,NCA 
10 VCK)=ACI,K) 

DO 30 J=I,NCB 
SUM=ZEPO 
00 20 K=1 ,NCA 
SS=VCK)*BCK,J) 

20 SUM=SUM+SS 
30 ZCI,J)=SUM 
DO 33 1=1, NR 
DO 33 J=I,NR 


NERROR = I 


NERROR = 2 



33 ZCJ.n = ZUtJ) 

RETURN 

40 00 70 l=ltNRA 
DO 50 K=1,NCA 
50 VCK»=A(I»K) 

DO 70 J=1,NCB 
SUM-ZERO 
DO 60 K=1,NCA 
SS=V(KI*BCK,J) 

60 SUM-SUM+SS 
70 Z(IfJ)-SUM 
RETURN 

999 CALL ZZB0MB(6HAB1 fNERROR) 
END 
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SUBROUTINE AB2 « A,B t Z*NRA tNCA,NCP ,KRA,KRB,KRZI 
DIMENSION A(KRA»1 ),e<KRBf II ,Z(KRZtlI 
COMMON / LWRKVl / VC500) 

DOUBLE PRECISION SUM.SStZERO 
DATA ZERO /O.D/ 

AB2 PERFORMS THE MATRIX OPERATION <ZI=(AI’«'(B) . 

AB2 CAN ALSO PERFORM THE OPERATIONS 
|Z) = IAM=(A) BY CALL AB2(A,AtZt — ETC — I 
(3) = CA)*(B| BY CALL A62(AtB,B, — ETC— I 

IF (61 AND (Zl DO NOT SHARE THE SAME STORAGE 
IT WOULD BF MORE EFFICIENT TO USE SUBROUTINE 
ABl TO PERFORM THIS OPERATION. 

IF NRA IS NEGATIVE AND ABS(NRA) IS EQUAL TO NCB 
A SQUARE, SYMMETRIC (Zl IS CALCULATED. 

MAXIMUM SIZE NCA=500 

INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 


FORMA SUBROUTINE ZZBOMB IS CALLED. 

CODED BY JOHM ADMIRE ♦NASA* JULY 1R72 . 
LAST REVISION BY RL WCHLEN. MARCH 1976. 


A 

— 

INPUT 

B 


INPUT 

Z 

— 

OUTPUT 

NRA 

— 

INPUT 

NCA 

— 

INPUT 

NCB 

— 

INPUT 

KRA 

- 

INPUT 

KRB 

— 

INPUT 

KRZ 


INPUT 


ARGUMENTS 

MATRIX (A I SI2E(NRA BY NCAI 

MATRIX (Bl SIZE(NCA BY NCPI 

MATRIX (Zl SIZECNRA BY NCBI 

ABS(NRAI IS THE NUMBER OF ROWS IN (Al 
NUMBER OF COLUMNS IN (A I 
NUMBER OF COLUMNS IN (Bl 
ROW DIMENSION OF (A I IN CALLING PROGRAM 
ROW DIMENSION OF (Bl IN CALLING PROGRAM 
ROW DIMENSION OF (Zl IN CALLING PROGRAM 


NERROR EXPLANATIONS 

1 = SIZE EXCEEDANCE. 

2 = NON-SQUARE RESULT ASKED FOR. 


NR=IABS(NRA1 

IF(NCA .GT. 500 .OR. NCA .GT. KRB .OR. NR .GT. KRA 
♦ .OR. NR .GT. KRZI GO TO 999 
IF(NRA .GT. 01 GO TO 40 

IF (NR .NE. NCBI GO TO 999 
DO 30 J=1,NCP 
DO 10 K=1,NCA 
10 V(KI=R(K,JI 
DO 30 1 = 1, J 
SUM=ZERP 
DO 20 K=1,NCA 
SS=A(I,KI*V(K| 


NERROR = 1 


NERROR = 2 



20 SUM=SUM+SS 
30 Z(I.J)=SUM 
DO 33 1=1 ,NR 
DC 33 J=ItNR 
33 Z( J,I)=Z( I,J) 

RETURN 

40 DO 70 J=1,NCP 
DO 50 K=1,NCA 
50 V(K)=B(K,J) 

DO 70 I=1,NRA 
SUM=ZERO 
DO 60 K=1,NCA 
SS=Aa,K)*V(K) 

60 SUM=SUM+SS 
70 Z(I,J)=SUM 
RETURN 

999 CALL ZZB0MB(6HAB2 ,NERROR) 
END 
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f UBROUTIKE ABCl ( A *6 ,C «Z »NRA ,NCA »NCB «KRA »KRB •KRC«KRZ I 
DIMENSION ACKRA,1I,P(KRB,1),C(KRC.»1 l•Z(KRZ•ll 
COMMON / LNRKVI / V 15001 
DOUBLE PRECISION SUM.SS 

ABCI PERFORMS THE MATRIX OPERATION (Z)=f AI^IBI^tC I . 

ABCl CAN ALSO PERFORM THE OPERATIONS 
<ZI-IA|»«PI+I Al BY CALL ABCI(A,B* A,Z» — ETC — 1 
<Zl = «Al’MR|*fBI BY CALL ABC1(A»B,B,Z« — ETC — I 
CZI = (AI*(A|+(CI PY CALL ABCKA.A, C,Z« — ETC — I 
<Z1 = CA)=*=C AI+CA) B^ CALL ABCI(A,A, A,Z, — ETC — 1 
IA)=IAl»«Bl+fCl BY CALL ABCl CA«B«C,A* — ETC — I 
CC| = IA|*CP)+<CI BY CALL ABC1(A,B«C,C« — ETC — I 
f A1 = (AI^CBI*IA1 BY CALL ABCl CA«B« A« A» — ETC — I 

IF NRA IS NEGATIVE AND ABS(NRA) IS EOUAL TO NCB 
A SCUARE, SYMMETRIC (Z1 IS CALCULATED. 

MAXIMUM SIZE NCA=500 

INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

FORMA SUBROUTINE ZZBCMB IS CALLED. 

CODED BY JOHN ADMIRE *NASA» JULY 1972 • 

LAST REVISIO»>l BY RL WOHLEN. MARCH 1976. 

ARGUMENTS 

A. A - INPUT MATRIX <A) SIZEfNRA BY NCA) 

C B - INPUT MATRIX (B) SIZEINCA BY NCBI 

C C - INPUT MATRIX CC ) SIZEfNRA BY NCBI 

C Z - OUTPUT MATRIX (Zl SIZEfNRA BY NCBI 

C NRA - INPUT ABSfNRAI IS THE NUMBER OF ROWS IN (Al 

C NCA - INPUT NUMBER OF COLUMNS IN (A I 

C NCB - INPUT NUMBER OF COLUMNS IN <B I 

C KRA - INPUT ROW DIMENSION OF (Ai IN CALLING PROGRAM 

C KPB - INPUT POW DIMENSION OF fBI IN CALLING PROGRAM 

C KRC - INPUT ROW DIMENSION OF fCI IN IN CALLING PROGRAM 

C KRZ - INPUT ROW DIMENSION OF (Zl IN CALLING PROGRAM 

C 

C NEPROR EXPLANATIONS 

C I - SIZE EXCEEDANCE. 

C 2 = NON-SCUARE RESULT ASKED FOR. 

C 

NR=IABS(NRA) 

NERROR = I 

IFfNCA .GT. 500 .OR. NR .GT. KRA .OR. NR .GT. KRC 
♦ .OR. NCA .GT. KRB .OR. NR .GT. KRZ I GO TO 999 
IFfNRA .GT. 01 GO TO AO 

IFfNP .NE. NCBI GO TO 999 
DO 30 1=1 ,NP 
DO 10 K=1,NCA 
10 V(Kl=Af I.K) 

OP 30 J=I,NCB 
SUM=C(I,J) 


NERROR = 2 
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DC 20 K=1 fNCA 
SS=V(K)«B(K,J) 

20 SUM-SUM+SS 
30 Z(IfJI=SUM 
00 33 1=1 *NR 
DO 33 J=IfNR 
33 Z( J,I)=ZC I»J) 

RETURN 

40 DC 70 1=1,NRA 
DO 50 K=lfNCA 
50 VCK)=A(I,K) 

00 70 J=1,NCB 
SUM=C(I,J ) 

DO 60 K=lfNCA 
S5=V(K»*B(K,JJ 
60 SUM=SUM+SS 
70 Z(I,J)=SUM 
RETURN 

999 CALL ZZB0MB(6HABC1 fNERROR) 
END 
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SUBROUT INE ABC? f A «B «C .Z ,NRA ,NCA«NCB *KRA ,KRB .KRCfKRZ I 
DIMENSION A(KRA,ll,B(KRB,ll,C<KRC,ll,Z(KRZ.ll 
COMMON / LWRKVl / V(500» 

OGUetE PRECISION SUM*SS 

ABC? PERFORMS THE MATRIX OPERATIfJN (Z >=CAI*CB >+CC I . 

ABC? CAN ALSO PERFORM THE OPERATIONS 
<ZI=(AI*(BI+{6I BY CALL A6C2(A,B»B,Z 
(Z»=(Al*(B)+(A) BY CALL A6C?(A,BtA,Z 
IZI=(A»»(A»+<C» BY CALL ABC?(A,A»C»Z 
fZ»=<A)*(A)+(A) BY CALL ABC?(A»AtA,Z 
(B» = (A)>MB|+(CI BY CALL ABC2IA,B.C,B 
CCI=(A)»CBI*(C) BY CALL ABC?(A»B»C»C 
= BY CALL ABC?(A»6»BtB 

IF (B> DOES NOT SHARE STORAGE WITH If) OP IZJ IT WOULD 
BE MORE EFFICIENT TO USE ABCl TO PERFORM THIS OPERATION . 

IF NRA IS NEGATIVE AND ABS(NRA) IS EQUAL TO NCB 
A SQUARE, SYMMETRIC IZJ IS CALCULATED. 

MAXIMUM SIZE NCA=500 

INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

FORMA SUBROUTINE ZZBOMB IS CALLED . 

CODED BY JOHN ADMIRE *NASAT JULY 197? . 

LAST REVISION BY RL WOHLEN. MARCH 1976. 


— ETC — 
— ETC — 
— ETC — 
— ETC — 
— FTC — 
— ETC — 
— ETC — 


ARGUMENTS 

A - INPUT MATRIX (A) SIZEINRA BY NCAI 

B - INPUT MATRIX (Bl SIZEINCA BY NCBJ 

C “ INPUT MATRIX 1C I SIZEINRA BY NCBI 

Z - OUTPUT MATRIX IZ) SIZEINRA BY NCBI 

NRA - INPUT ABSINRAI IS THE NUMBER OF ROWS IN lAI 
NCA - INPUT NUMBER OF COLUMNS IN |A) 

NCB - INPUT NUMBER OF COLUMNS IN IB I 

KRA - INPUT ROW DIMENSION OF lA) IN CALLING PROGRAM 

KRB ~ INPUT ROW DIMENSION OF IBI IN CALLING PROGRAM 

KRC - I^'PUT ROW DIMENSION OF 1C) IN CALLING PROGRAM 

KRZ ~ INPUT ROW DIMENSION OF IZI IN CALLING PROGRAM 

NERROR EXPLANATIONS 

1 = SIZE EXCEEDANCE. 

2 = NON-SQUARE RESULT ASKED FOR. 


NR=IABS|NRAI 

IF INCA .GT. 500 .OR. NCA .GT. KRB .OR. NR .GT. KRC 
♦ .OR. NR .GT. KRA .OR. NR .GT. KRZ) GO TO 999 
IFINRA .GT. 0) GO TO 40 

IF (NR .NE. NCB) GO 70 999 
DO 30 J=l,NCe 
DO 10 K=1,NCA 


NERROR = 1 


NERROR = 2 
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10 VCK)=B(K,J» 

00 30 I=lfJ 
SUM=C(I,JI 
DC 20 K=1,NCA 
SS=AII*K)*V(KI 
20 SUM=S0M^SS 
30 Z(I,J)=SUM 
00 33 I-1»NR 
DO 33 J=IfNR 
33 2(J,I)=Z(I*J) 
RETURN 

40 DO 70 J=ltNCB 
DO 50 K=1,NCA 
50 V(K)=eCK,J) 

DO 70 I=1»NRA 
SUM=C(If J) 

DO 60 K=1»NCA 
SS=ACI.K|*V(K) 

60 SUM=SUM+SS 
70 ZCltJ)=SUM 
RETURN 

999 CALL ZZB0MBC6HABC2 
END 


• NERROR) 
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SUBROUTiME ALODl I PP, DIST fCONC.CONVRT t Zf NPP.NDtNCt KD*KC) 
DIMENSION PP(1 J, DIET (KOtUfCONCCKC ,l)f 2(1 J 
COMMON /LLINE /NLINE,MAXLIN»MINI 
DATA NiT, NOT/5, 6/ 

REPLACE r.ISTRIBUTED AND CONCENTRATED LATERAL FORCES ON A BEAM 
WITH REF fESENTATIVE CONCENTRATED FORCES AT THE PANEL POINTS. 

THIS ENTAILS BEAMING BAY FORCE TO ADJACENT PANEL POINTS. 

THE D:SYUIBUTE0 force may not EXCEED THE PANEL POINT LIMITS. 

THE concentrated FORCES MAY BE OUTSIDE THE PANEL POINT LIMITS. 

OPTION TO OMIT FORCE DATA BY ND OR NC EQUAL ZERO. 

CALLS FORMA SUBROUTINES PAGEHD ,ZZBOMB. 

CODED BY RL WOHLEN. FEBRUARY 1970. 

LAST REVISION BY WA BENFIELD. MARCH 1976. 

SUBROViTINE ARGUMENTS 

PP = INPUT VECTOR OF PANEL POINTS. SIZECNPPI. 

DIST - INPUT MATRIX OF DISTRIBUTED FORCE STRAIGHT LINE 

SEGMENT DATA. S12E(ND,A). 

COL 1 = X AT SEGMENT END 1. 

COL 2 = X AT SEGMENT END 2. 

COL 3 = FORCE AT SEGMENT END 1. 

COL A = FORCE AT SEGMENT ENO 2. 

CONC = INPUT MATRIX OF CONCENTRATED FORCE DATA. S1ZE(NC,2). 

COL 1 = X COORDINATE. 

COL 2 = FORCE. 

CONVRT = INPUT CONVERSION SCALAR BY WHICH COLS 3,4 OF DIST AND 

COL 2 OF CONC WILL BE MULTIPLIED. 

Z = OUTPUT VECTOR OF CONCENTRATED PANEL POINT FORCES. SIZE(NPPI. 

NPP = INPUT r MBER OF PANEL POINTS. SIZE OF VECTORS PP,Z. 

ND - INPUT NUMBER OF SEGMENTS (ROWS) IN DIST. CAN BE ZERO. 

NC = INPUT NUMBER OF FORCES (ROWS) IN CONC- CAN BE ZERO. 

KD = INPUT ROW DIMENSION OF DIST IN CALLING PROGRAM. 

KC = SNPUT ROW DIMENSION OF CONC IN CALLING PROGRAM. 

MERRDR EXPLANATION 

1 = LESS THAN 2 PANEL POINTS. 

2 = PANEL POINTS IN INCREASING ORDER. 

3 = INCORRECT DISTRIBUTED DATA. 

2001 FORMAT ( 3; /) ,30X ,31HSUBR0UTINE ALODl USES CONVRT = E15.8, / 

* ^7X,33HAND COMPUTES THE TOTAL PROPERTIES / 

* 45X,16HLATERAL FORCE = E15.8, / 

* 40X,21HCENTER OF PRESSURE = E15-8) 

2002 FOP AT(/1X131(1H-)) 

CHEoK THAT PANEL POINTS ARE IN INCREASING ORDER. 

NERROR = 1 

IF (NPP .'Y. 2) GO TO 999 

NERROR = 2 

DO S <=2»NPP 

5 TF »PP(K“1) .GE. PP(K)) GO TO 999 

C INITIALIZE DATA. 

DO 10 I=ivNPP 
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10 zm = 0.0 

NBAYS = NPP-1 

BRANCH TO APPROPRIATE SECTION. 

IF(ND .to. 01 GO TO 100 

SOLVE FOR DISTRIBUTED INPUT. 

DO 90 1=1, NO 
XI = DISTU,!) 

X2 = 0IST(I,2I 
FI = DIST(I,3)*C0NVRT 
F2 = OISTCI.AKCONVRT 

NERROR = 3 

IF (XI .LT. PP(U .OR. X2 .GT. PP(NPP| .OR. XI .GE. X2 1 GO TO 999 
DO 32 K=l, NBAYS 

32 IF (XI .LT. PP(K+in GO TO 3A 
34 XP = XI 
FP = FI 

36 IF (X2 .LE. PP(K+in GO TO 38 
XQ = PP(K+1I 

FQ = F1 ♦ (XQ-X1)*(F2-F1»/(X2-X1) 

GO TO 39 

38 XQ = X2 
FQ = F2 

39 BAYL = PP(K+1 |-PP(KI 
SEGL = XQ-XP 

2(K) = Z(K> ♦ SEGL*(FP*(3.*(PP(K+n-XP)-SEGLI 

♦ ♦FQ*(3.*(PP(K+1)-XP)-2.*SEGL))/(6.^BAYLI 
Z(K+1) = Z(K+1) ♦ SEGL>MFP=M3.»(XP-PP(K)I+SEGL) 

♦ ♦F0»(3.’«'(XP-PP(Kn+2.*SEGL!l/(6.*BAYLI 
IF (X2 .LE. PP(K+in GO TO 90 
K = K+1 
XP = XQ 
FP = FO 
GO TO 36 

90 CONTINUE 

SOLVE FOR CONCENTRATED FORCE. 

100 IF(NC .EQ. 01 GO TO 200 
00 103 T=1,NC 
XC = CONCdtl ) 

FC = C0NC(I,2I*C0NVRT 
DO 101 K=l, NBAYS 

101 IF (XC .LE. PP(K*in GO TO 102 
K = NBAYS 

102 BAYL = PP(K+1) - PP(K) 

Z(KI = Z(K1 ♦ FfXPP(K^ll'-XCI/PAYL 

103 Z(K+1I = Z(K+1I ♦ FC*(XC“PP(KII/BAYL 
C 

C COMPUTE AND PRINT TOTAL PROPERTIES. 

200 TF = 0.0 
TP = 0.0 

00 201 1=1, NPP 
TF = TF ♦ Z(I) 

201 TP = TP Zni+PPdl 
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CP - TP/TF 

IFIMINI .NE. 4HMINI1 GO TO 300 

IF(NLINF .LF. 5 -OR. NLINE -GE. MAXLIN) GO TO 300 
IF(NLINF +9 -GT. MAXLIN 1 GO TO 300 
HRiTEiNOT, 20021 
NLINE=NLINE+2 
GO TO 310 
300 CALL PAGE HO 

310 WRITEINOT, 20011 CONVRT.TFtCP 
NLINE=NLINE*7 
RETURN 

999 CALL Z2B0MB (6HAL0D1 ,NERR0R1 
END 
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SUBROUTINE ALCD2 <PP»DIST,CONC,CONVRT, Z, NPP,ND,NC* KD,KCI 
DIMENSION PP(1) ,DIST(KD,1I *CONC CKC tl 1 1 ZUI 
COMMON /LLINE /NLINE,MAXLIN,MINI 
DATA NIT, NOT/5,6/ 

REPLACE DISTRIBUTED AND CONCENTRATED AXIAL FORCES ON A BEAM WITH 
representative CONCENTRATED FORCES AT THE PANEL POINTS. 

THIS ENTAILS PLACING BAY FORCE AT AFT KX IS AFTI PANEL POINT OF BAY. 
THE DISTRIPUTEO FORCE MAY NOT EXCEED THE PANEL POINT LIMITS. 

THE CONCENTFA'^EO FORCES MAY BE OUTSIDE THE PANEL POINT LIMITS. 

OPTION TO OMIT FORCE DATA BY NO OR NC EQUAL ZERO. 

CALLS FORMA SUBROUTINES PAGEHD ,ZZBOMB . 

CODED BY RL WOHLEN. FEBRUARY 1970. 

LAST REVISION BY WA BENFIELD. MARCH 1976. 

SUBROUTINE ARGUMENTS 

PP = INPUT VECTOR OF PANEL POINTS. SIZE<NPP). 

DIST = INPUT MATRIX OF DISTRIBUTED FORCE STRAIGHT LINE 

SEGMENT DATA. SIZE(ND,A>. 

COL 1 = X AT SEGMENT END 1. 

COL 2 = X AT SEGMENT END 2. 

COL 3 = FORCE AT SEGMENT END I. 

COL A = FORCE AT SEGMENT END 2. 

CCNC = INPUT MATRIX OF CONCENTRATED FORCE DATA. SIZE(NC,21. 

COL 1 = X COORDINATE. 

COL 2 = FORCE. 

CONVRT = INPUT CONVERSION SCALAR BY WHICH COLS 3, A OF OIST AND 

COL 2 OF CONC WILL BE MULTIPLIED. 

Z = OUTPUT VECTOR OF CONCENTRATED PANEL POINT FORCES. SIZECNPPJ. 

NPP = INPUT NUMBER OR PANEL POINTS. SIZE OF VECTORS PP,Z. 

ND = INPUT NUMBER OF SEGMENTS IROWS) IN OIST. CAN BE ZERO. 

NC = INPUT NUMBER OF FORCES <ROWS) IN CONC. CAN BE ZERO. 

KD = INPUT ROW DIMENSION OF DIST IN CALLING PROGRAM. 

KC = INPUT ROW DIMENSION OF CONC IN CALLING PROGRAM. 

CONVRT = INPUT CONVERSION SCALAR BY WHICH COLS 3, A OF OIST AND 

NERROR EXPIANATION 

1 LESS THAN 2 PANEL POINTS. 

2 = PANEL POINTS NOT IN INCREASING ORDER. 

3 = INCORRECT DISTRIBUTED DATA. 

2001 FORMAT { 3(/) ,30X,31HSUPR0UTINE ALOD? USES CONVRT = E15.8, / 

♦ 30X,37HAND COMPUTES THE TOTAL AXIAL FORCE = E15.8J 

2002 F0RMAT(/1X13I (IH-n 

CHECK THAT PANEL POINTS ARE IN INCREASING ORDER. 

NERROR = 1 

IF (NPP .LT. 2) GO TO 999 

NERROR = 2 

DO 5 K=2,NPP 

5 IF (PP(K-n .GE. PPtKH GO TO 999 

INITIALIZE DATA. 

DO 10 1 = 1, NPP 
10 Z(I) = 0.0 
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NBAYS = NPP-l 

C BRANCH TO APPROPRIATE SECTION. 

IF(ND .EQ. 0) GO TO 100 

SOLVE FOP DISTRIBUTED INPUT. 

00 90 1=1, ND 
XI = DIST(I,1) 

X2 = DIST(I,2) 

FI = DIST(I,3)^C0NVRT 
F2 = 0IST(I,4|*C0NVRT 

NERROR = 3 

IF (XI .LT. PP(1) .OR. X2 .GT. PPINPPI .OR. XI .GE. X2I GO TO 999 
DO 32 K=l, NBAYS 

32 IF (XI .LT. PP(K+D) GO TO 34 
3A XP = XI 
FP = FI 

36 IF (X2 .LE. PP(K-HI) GO TO 38 
XQ = PP(K+1 I 

FO = FI ♦ (XQ~X1I=>=(F2-F1I/(X2-X1I 

GO TO 39 

38 XO = X2 
FQ = F? 

39 Z(K+1I = Z(K+1I ♦ .5’i'(FP+F0)*(XQ-XP) 

IF (X2 .LE. PP(K-mi GO TO 90 
K = K+1 
XP = XO 
FP = FO 
GO TO 36 

90 CONTINUE 

SOLVE FOR CONCENTRATED FORCE. 

100 IF(NC .EC. 0) GO TO 200 
DC 103 1=1, NC 
XC = C0NC(I,1) 

FC = CONCd^ZI^CONVRT 
IF (XC .LE. PP(D) Z(ll = Z(1I+FC 
IF (XC .LE. PP(in GO TO 103 
DO 101 K=l, NBAYS 

101 IF (XC .LE. PP(K+in GO TO 102 
K = NRAYS 

102 Z(K+U = Z(K+1I ♦ FC 

103 CONTINUE 

COMPUTE AND PRINT TOTAL PROPERTIES. 

200 TF = 0.0 
DO 201 1=1, NPP 

201 TF = TF ♦ Z(I) 

IF (MINI .NF. 4HMINIJ GO TO 300 

IF(NLINE .LE. 5 .OR. NLINE .GE. MAXLIN) GO TO 300 
IF(NLINE +7 .GT. MAXLIN 1 GO TO 300 
WRITE(N0T,2002: 

NLINE=NLINE*2 
GO TO 310 
300 CALL PAGEHD 
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310 WRITE <N0T,20^'M C0NVRT,TF 
NLlNE=NLINE+5 
RETURN 

999 CALL 2ZB0MB (6HAL002 ♦NERROR) 
END 



ALPHAA 


SUBROUTINE ALPHAA ( ALPHAt A, Zt NRtNCtKR I 
DIMENSION ACKRfDf Z(KRtl» 

C 

C SCALAR ALPHA TIMES MATRIX A. (ALPHA * A = 2). 

C MATRICES A,Z MAY SHARE SAME CORE LOCATIONS. 

C CODED BY RL WOHLEN. FEBRUARY 1965. 

C 

C SUBROUTINE ARGUMENTS 

C ALPHA - INPUT SCALAR. 

C A = INPUT MATRIX. SIZE(NR,NC). 

C 2 = OUTPUT result MATRIX. SIZF(NRtNC). 

C NR = INPUT NUMBER OF ROWS IN MATRICES AtZ. 

C NC = INPUT NUMBER OF COLS IN MATRICES AtZ. 

C KR = INPUT ROW DIMENSION OF AtZ IN CALLING PROGRAM. 

C 

DO 10 1=1 »NR 
DO 10 J=1,NC 

10 Z(ItJ) = ALPHA ★ AdtJI 
RETURN 
END 
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SUBROUTINE ASSEM ( At IRZt JCZf ZtNRA»NCArNRZtNCZ*KRAtKRZ) 

DIMENSION AlKRAtDt Z(KRZ,1J 
C 

C MATRIX ASSEMBLY. (MATRIX A INTO MATRIX Z ). 

C BE SURE MATRIX Z DEFINED BEFORE CALLING THIS SUBROUTINE. FOR 

C EXAMPLE, CALL ZERO TO CLEAR MATRIX Z. 

C CALLS FORMA SUBROUTINE ZZBOMB. 

C CODED BY RL WOHLEN. FEB 1965. 

C LAST REVISION BY RL WOHLEN. MARCH 1976. 

C 

C SUBROUTINE ARGUMENTS 

C A = INPUT MATRIX. S IZ E (NR A, NC A ) . 

C IRZ = INPUT ROW NUMBER IN MATRIX Z OF FIRST ROW OF MATRIX A. 

C JCZ s INPUT COL NUMBER IN MATRIX Z OF FIRST COL OF MATRIX A. 

C Z = OUTPUT RESULT MATRIX. SIZE (NRZ,NCZ I. 

C NRA = INPUT NUMBER OF ROWS OF MATRIX A. 

C NCA = INPUT NUMBER OF COLS OF MATRIX A. 

C NRZ - INPUT NUMBER OF ROWS OF MATRIX Z. 

C NCZ = INPUT NUMBER OF COLS OF MATRIX Z. 

C KRA - INPUT ROW DIMENSION OF A IN CALLING PROGRAM. 

C KRZ = INPUT ROW DIMENSION OF Z IN CALLING PROGRAM. 

C 

C NFRROR EXPLANATION 

C 1 s MATRIX A EXCEEDS MATRIX Z - ROWS. 

C 2 = MATRIX A EXCEEDS MATRIX Z COLUMNS. 

C 

NERROR = 1 

IF ((IRZ-l+NRA) .GT. NRZI GO TO 999 

NERROR = 2 

IF ((JCZ-l+NCA) .GT. NCZ) GO TO 999 
C 

DO 10 IA=1,NRA 
IZ = lA + IRZ - 1 
DO 10 JA=l,NCA 
JZ = JA + JCZ - 1 
10 Z(IZtJZ) = A(lAtJA) 

RETURN 

C 

999 CALL ZZBOMB (6HASSEM , NERROR) 

END 
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SUBROUTINE ATU A, Z,NR ,NC tKR A, KRZ) 

DIMENSION A(KRAf DtZiKRZtl} 

COMMON / LWRKVl / V(500I 

ATI PERFORMS THE OPERATION C Z l = U A JTRANSPOSE I 
ATI CAN ALSO PERFORM THE OPERATION 
lAI=<(A»TRANSPOSE) BY CALL ATI (A* A, — ETC — ) 

MAXIMUM SIZE NC=500 


FORMA SUBROUTINE 2ZBOMB IS CALLED 
CODED BY JOHN ADMIRE ♦NASA’^ JULY 1972 . 


A - INPUT 
Z - OUTPUT 
NR - INPUT 
NC - INPUT 
KRA - INPUT 
KRZ - INPUT 


ARGUMENTS 

MATRIX (AJ SIZEfNR BY NCI 

MATRIX IZI SIZE(NC BY NRI 

NUMBER OF ROWS IN (AI 
NUMBER OF COLUMNS IN (A) 

ROW DIMENSION OF (Al IN CALLING PROGRAM 
ROW DIMENSION OF fZ) IN CALLING PROGRAM 


NERROR=l 

IFINC . 500 -OR. NC .GT. KRZ .OR. NR .GT. KRAI GO TO 999 
N=NR 

IF(NC .LT. NRI N=NC 
DO 40 K=1 ,N 
DO 10 J=KtNC 
10 V(JI=A(K,J) 

DO 20 I=K,NR 
20 Z (K,II=Ar I,KI 
DO 30 J=K,NC 
30 ZIJ,K|=V(JI 
40 CONTINUE 
RETURN 

999 CALL ZZB0MB(6HAT1 ,NERRORI 
END 
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SUBROUTINE ATBl ( A,B ,Z ,NRA ,NCA ,NCB ,KRA ,KRB tKRZ ) 

DIMENSION A(KRA,1I,B(KRB,1) ,Z(KRZtl) 

COMMON / LWPKVl / V(500l 
DOUBLE PRECISION SUM,SS»ZERO 
DATA ZERO /O.D/ 

ATBl PERFORMS THE OPERATION ( Zl = ( (A ITRANSPOSE I’MB) . 

ATBl CAN ALSO BE USED TO PERFORM THE OPERATIONS 
(AI=(C A)TRANSPPSE)*(B) BY CALL ATB1(A,B,A, — ETC — ) 
(ZI=((AJTRANSPOSE|*(A| BY CALL B1(A,A,Z, — ETC — I . 

IF NRA IS NEGATIVE AND NCA IS EQUAL TO NCB 
A SQUARE, SYMMETRIC <Zl IS CALCULATED. 

IF <AI DOES NOT SHARE STORAGE WITH (Zi IT WOULD 

BE MORE EFFICIENT TO USE ATB2 TO PERFORM THIS OPERATION • 

MAXIMUM SIZE NRA=500 

INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

FORMA SUBROUTINES ZZBOMB AND ATI ARE CALLED. 

CODED BY JOHN ADMIRE *NASA» JULY 1972 . 

LAST REVISION BY RL WOHLEN. MARCH 1976. 


A 

- 

INPUT 

B 

- 

INPUT 

Z 

— 

OUTPUT 

NRA 

— 

INPUT 

NCA 

- 

INPUT 

NCB 


INPUT 

KRA 

- 

INPUT 

KRB 

— 

INPUT 

KRZ 

— 

INPUT 


ARGUMENTS 

MATRIX (Al SIZE(NRA BY NCA) 

MATRIX (B) SIZECNRA BY NCB) 

MATRIX (ZI SIZE(NCA BY NCBI 

ABSINRAI IS THE NUMBER OF ROWS IN 
NUMBER OF COLUMNS IN (A) 

NUMBER OF COLUMNS IN 
ROW DIMENSION OF (A) 

ROW DIMENSION OF (Bl 
ROW DIMENSION OF (ZI 


(PI 

IN CALLING 
IN CALLING 
IN CALLING 


(Al 


PROGRAM 

PROGRAM 

PROGRAM 


NERROR EXPLANATIONS 

1 = SIZE EXCEEDANCE. 

2 = NON-SQUARE RESULT ASKED FOR. 


NR= IAPiS(NRAl 

NERROR = 1 

IF(NR .GT. 500 .OR. NR .GT. KRA .OR. NR .GT. KRB 
♦ .OR. NCB .GT. KRZ .OR. NCA .GT. KRZI GO TO 999 
IF (NRA .GT. 01 GO TO 40 

NERROK = 2 

1F(NCA .NE. NCBI GO TO 999 
DO 30 1 = 1 ,NCA 
DO 10 K=1,NR 
10 V(K|=A(K,II 
DO 30 J=I,NCB 
SUM=ZERO 
DO 20 K=1,NR 
SSi=V(K|*B (K,J| 

20 SUM=SUM+SS 
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30 Z(J,II=SUM 
00 33 1=1, NR 
00 33 J=I,NR 
33 ZfI,JI=Z(J,n 
PFTURN 

40 00 70 I=1,NCA 
00 50 K=1,NRA 
50 VIK)=A(K,I) 

DO 70 J=l,NCe 
SUM=ZFRC 
DC 60 K=1,NPA 
SS=V(KI*B CK,J| 

60 SUN=SUM+FS 
70 Z(J,II=SUM 

CALL AT1(2,2,NCB,NCA,KRZ,KRZI 
PETURN 

999 CALL ZZB0MB(6HATB1 ,NERRCR1 
END 
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SUBROUTINF ATB2 ( A ,6 »2 ,NRA ♦NCA ,NCB »KRA,KRB,KR2 » 
DIMENSION A(KRA,I»,P(KRe,l| ,2(KRZ,1) 

COMMON / LWRKVl / VC500) 

OnUELE PRECISION SUM,SS*ZERO 
DATA ZERO /O.D/ 

ATB2 PERFORMS THE OPERATION <Z ) = (( A» TRANSPOSE I’M BI 
ATB2 CAN ALSO BE USED TO PERFORM THE OPERATIONS 
(P|=((AI*TRANSPOSEI*(FI PY CALL ATB2(A,B,B« — ETC — ) 
(Z) = ((A)*TRANSPOSE»=MAJ BY CALL ATB2fA,AtZ« — ETC — I 

IF NRA IS NEGATIVE AND NCA IS EQUAL TO NCB 
A SQUARE, SYMMETRIC (Zl IS CALCULATED. 

MAXIMUM SIZE NRA=500 

INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

FORMA SUBROUTINE ZZPOMP IS CALLED . 

CODED BY JOHN ADMIRE »NASA* JULY 1972 . 

LAST REVISION BY RL WOHLEN. MARCH 1976. 


A 

— 

INPUT 

B 

— 

INPUT 

Z 

- 

OUTPUT 

NRA 

- 

INPUT 

NCA 

- 

INPUT 

NCB 

- 

INPUT 

KRA 

- 

INPUT 

KRB 

-- 

INPUT 

KRZ 


INPUT 


ARGUMENTS 

MATRIX CA» SIZECNRA BY NCAl 

MATRIX «B) SIZE(NRA BY NCBI 

MATRIX (Z) SIZECNCA BY NCBJ 

ABSINRA) IS THE NUMBER OF ROWS IN 
NUMBER OF COLUMNS IN lAI 
NUMBER OF COLl»^NS IN 
ROW DIMENSION OF (A» 

ROW DIMENSION OF (B) 

ROW DIMENSION OF (Z» 


<B) 

IN CALLING 
IN CALLING 
IN CALLING 


(A) 


PROGRAM 
PROG*: 'M 
program 


NERRCR EXPLANATIONS 

1 = SIZE EXCEEDANCE. 

2 = NON-SQUARE RESULT ASKED FOR. 


NR=IABS(NRAI 

NERROR = 1 

IF(NR .GT. 500 .OR. NR .GT. KRB .OR. NR .GT. KRA 
♦ .OR. NCA .GT. KRZ) GO TO 999 
IF(NRA .GT. 01 GO TO 40 

NERROR = 2 

IF<NCA .NE. NCB) GO TO 999 
DO 30 J=1,NCB 
DO 10 K=1,NR 
10 V(K)=B(K,J) 

DO 30 1=1, J 
SUM=ZERO 
DO 20 K=1,NR 
SS=A(K,I I^VIKI 
20 SUM=SUM+SS 
30 Z(I,J)=SUM 
DO 33 1=1, NR 
DO 33 J=I,NR 



33 Z(Jtn=Z<ItJ) 
RETURN 

40 00 70 J=1»NCB 
DO 50 K=l,NRA 
50 V(KI=B<K,J> 

DO 70 I=l,NCA 
SUMS ZERO 
DC 60 K=1»NRA 
SS=A(K,n*V(K» 

60 SUM=SUM+SS 
70 ZfltJ»=SUM 
RETURN 

999 CALL ZZB0MBC6HATB2 
END 


,NERROR) 
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SUBROUTINE ATECH A,B»CtZ*NRA,NCA,NCBtKRA.KRB,KRC*KRZl 
DIMENSION A(KRA,1 ),B(KRB«1} ,C(KRC«1 )«Z(KRZ»1) 

COMMON / LWRKVI / V(500| 

DOUBLE PRECISION SUM.SS 
C 

C ATBCl PERFORMS THE OPERATION (Z I=C ( A) TRANSPOSE )♦( B»+(C I . 

C ATBCl CAN ALSO BE USED TO PERFORM THE OPERATIONS 

C IZ| = UAITRANSPrSEl’»'(P) + (A) BY CALL ATBCK A,B,A,Z* — ETC — I 

C (ZI = (CA)TRANSPOSE»*(BI + CBI BY CALL ATBCK A«B«B«Z« — ETC — I 

C <Z) = (<A)TRANSPOSE)’MA) + (Cl BY CALL ATBCKA* A,C,Zr — ETC — ) 

C (Zl = ( (AJTRANSPCSEI>MAI + (A) BY CALL ATBCl ( A,A»A«Z» — BTC — I 

C lA» = nAITRANSPCSEI<‘(P) + (Cl BY CALL ATBC1(A»P«C« A* — ETC — ) 

C CA) = C{A)TRANSPOSEI*(B) + (B) BY CALL ATBCK A*Bt6, A, — ETC — 1 

C 

C IF NRA IS NEGATIVE AND NCA IS EQUAL TO NCB 

C A SQUARE, SYMMETRIC (Zl IS CALCULATED. 

C 

C IF (A I DOES NOT SHARE STORAGE WITH <Z) OR CCI IT WOULD 

C BE MORE EFFICIENT TO USE ATBC2 TO PERFORM THIS OPERATION . 

C 

C MAXIMUM SIZE NRA=500 

C 

C INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

C 

C FORMA SUBROUTINES ZZBOMB AND ATI ARE CALLED . 

.C CODED BY JOHN ADMIRE *NASA* JULY 1972 . 

LAST REVISION BY RL WOHLEN- MARCH 1976. 

C ARGUMENTS 

C A - INPUT MATRIX (A) SIZECNRA BY NCA) 

C E ~ INPUT MATRIX (B) SIZECNRA BY NCB) 

C C - INPUT MATRIX (C) SIZECNCA BY NCB) 

C Z - OUTPUT MATRIX CZ) SIZECNCA BY NCB) 

C NRA - INPUT ABSCNRA) IS THE NUMBER OF ROWS IN CA) 

C NCA - INPUT NUMBER OF COLUMNS IN CA) 

C NCB - INPUT NUMBER OF COLUMNS IN CR) 

C KRA - INPUT ROW DIMENSION OF CA) IN CALLING PROGRAM 

C KRP - INPUT ROW DIMENSIC:« OF CB) IN CAILING PROGRAM 

C KRC - INPUT ROW DIMENSION OF CO IN CALLING PROGRAM 

C KRZ - INPUT ROW DIMENSION OF CZ) IN CALLING PROGRAM 

C 

C NERROP EXPLANATIONS 

C 1 = SIZE EXCEEDANCE. 

C 2 = NON-SQUARE RESULT ASKED FOR. 

C 

NR=IABS(NRA) 

NERROR = 1 

IFCMR .GT. BOO .OR. NR ,GT . KRA .OP. T-iCA -GT. KRC 
♦ .OR. NR .GT. KRB .OR. NCB .GT. KRZ .OR. NcA .GT. KRZ) GO TO 999 
IFCNRA .GT. 0) GO TO 40 

IFCNCA .NE. NCBJ GO TO 999 
DO 30 1=1 ,NCA 
DC 10 K=1,NR 
10 V(K)=ACK,I) 


NERROR = 2 
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DO 30 J=I,NCB 
SUM=C(ltJ) 

00 20 K=1,NR 
SS=V(K)»P (K,J1 
20 SUM=SUM+$S 
30 ZCJ,I1=SUM 
00 33 1=1 
00 33 J=ItMR 
33 Z(I*JI = ZCJ*H 
RETURN 

40 on 70 1 = 1, NCA 
DO 50 K=1,NRA 
50 V(K)=A(K,I) 

DO 70 .‘=ltNCB 

suM=<:{i ,j) 

DO 60 K=1»NRA 
SS=V(KJ^B<K,J J 
60 SUM=SUM+SS 
70 Z(J,n = 5UM 

CALL AT1(Z,Z,NCB.NCA*KRZ»KRZ) 
RETURN 

999 CALL ZZBCMBC6HATBC1 ,NERROR) 
END 
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SUBROUTINE ATPC2 I A,P, C, 2»NR A*NCA,NCB*KR A,KRB,KRC.KR2 I 
DIMENSION A(KRA«l),Bf KRB,1I,CIKRC,1),Z(KR2»1I 
COMMON / LWRKVl / V 1500 1 
DOUBLE PRECISION SUM,SS 

ATBC2 PERFORMS THE OPERATION ( 2 ) = U A )TR ANSPOSE )♦ (B l♦(C I . 
ATBC2 CAN ALSO BE USED TO PERFORM THE OPERATIONS 
IZI = HA)TRANSPPSE)*(B 1 + (A I BY CALL ATBC2(A,B«A*Zt — ETC — I 
(Z)=<<A)TRANSPOSE|*<B)*fB) BY CALL ATBC2I A,B«6tZ« — ETC — ) 
(Zl=( (A)TRANSPCSEI*<A»^IC J BY CALL ATBC2I A»A«C»Zt — ETC — I 
(2»=(<A)TRANSP0SEI*(A)+tA) BY CALL ATBC2( A»A,A«Z* — ETC — I 
(P)=C(A)TPANSPOSEI*(B )+CCI BY CALL AT6C2(A,B«C,B« — ETC — ) 
<C1=( (A|TPANSPOSE»*(e I+«C) BY CALL ATBC2(A,B,C,C. — ETC — » 
(B»=((A)TRANSPOSE»*(B I+CB) BY CALL ATBC2( A,B.B,B* — ETC — I 

IF NRA IS NEGATIVE AND NCA IS EQUAL TO NCB 
A SQUARE, SYMMETRIC (21 IS CALCULATED. 

MAXIMUM SIZE NRA=500 

INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION- 

FORMA SUBROUTINE ZZEOMP IS CALLED- 
COOEO BY JOHN ADMIRE ♦NASA* JULY 1«»72 . 

LAST REVISION BY RL WOHLEN. MARCH 1976. 

ARGUMENTS 

A - INPUT MATRIX (Al SI2E(NRA BY NCAJ 

e - INPUT MATRIX (B) S1ZE(NPA BY NCBJ 

C - INPUT MATRIX (Cl SIZE(NCA BY NCBI 

2 - OUTPUT MATRIX (21 SIZE(NCA BY NCB) 

NRA - INPUT ABS(NRA) IS THE NUMBER OF ROWS IN (A) 

NCA - INPUT NUMBER OF COLUMNS IN (A) 

NCB - INPUT NUMBER OF COLUMNS IN (P) 

KRA - INPUT ROW DIMENSION OF (A) IN CALLING PROGRAM 

KRP - INPUT ROW DIMENSION OF (B) IN CALLING PROGRAM 

KRC - INPUT ROW DIMENSICiN OF (C ) IN CALLING PROGRAM 

KRZ - INPUT ROW DIMENSION OF (2) IN CALLING PROGRAM 

NERROR EXPLANATIONS 

1 = SIZE EXCEEDANCE. 

2 = NON -SQUARE RESULT ASKED FOR. 


NR=IAES(NRA) 

IF (NR .GT. 500 .OR. NR .GT. KRB .OR. NCA .GT. KRC 
♦ .OR. NR .GT. KRA .OR. NCA .GT. KRZ) GO TO 999 
IF(NRA .GT. 0) GO TO 40 


NERROR = 1 


IFINCA .NE. NCB) GO TO 999 
DO 30 J=1,NCB 
DO 10 K=1,NR 
10 V(K)=B(K,J) 

DO 30 1=1, J 
SUM=C(I,J) 


NERROR = 2 
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DO 20 K=1,NR 
SS=A(K,I )*V(K» 

20 SUM=SUM+SS 
30 ZCItJl=SUM 
DO 33 I=1,NR 
DO 33 J=IfNR 
33 Z(J,n = Z(l,J) 

RETURN 

40 DO 70 J=ltNCB 
DO 50 K=1,NRA 
50 V(K)=e(K,JI 
DO 70 I=ltNCA 
SUM=C(I,J) 

DO 60 K=1,NRA 
SS=A(K,1)4V(K) 

60 SUM=SUM+SS 
70 Z(I,J)=SUH 
RETURN 

999 CALL ZZB0MBI6HAVBC2 ,NERROR) 
END 
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SUPPOUTINE ATXPAl f AZ ,B ♦NPP ,NCB,KAZ,KBI 
DIMENSION AZ(KAZ,1), B(K6«1) 

COMMON /LWRKV1/W(500) 

DOUBLE PRECISION S,SStZERO 
DATA ZERO /O.D/ 

C 

C SPECIAL MATRIX MULTIPLICATION. AITRANSPOSEI ♦ B = Z. 

C Z WILL BE SYMMETRIC. 

C USES TWO MATRIX SPACES. RESULT (Z) IS PLACED IN A. 

C AZ MUST BE DIMENSIONED LARGE ENOUGH IN MAIN PROGRAM TO CONTAIN THE 
C LARGER OF A OP Z. 

C INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

C CALLS FORMA SUBROUTINE 2ZBOMB. 

C THE MAXIMUM SIZE IS 
C NCB = 500 

C DEVELOPED BY RL WOHLEN. SEPTEMBER 1972. 

C LAST REVISION BY RL WOHLEN. MARCH 1976. 

C 

C SUBROUTINE ARGUMENTS 

C AZ = INPUT 1ST MATRIX. S I2E ( NRB.NCP I - 

C = OUTPUT RESULT MATRIX. SI ZE (NCB ,NCB ) . 

C B = INPUT 2ND MATRIX. SIZE(NRB,NCB1 • 

C NRB = INPUT NUMBER OF ROWS OF MATRIX B* COLS OF MATRIX ACTRANSI. 

C NCB = INPUT NUMBER OF COLS OF MATRIX B, ROWS OF MATRIX A(TRANS», 

C SIZE OF MATRIX Z( SQUARE I. MAX=500- 

C KAZ = INPUT ROW DIMENSION OF AZ IN CALLING PROGRAM, 

y KB = INPUT ROW DIMENSION OF B IN CALLING PROGRAM. 

C NERROR EXPLANATION 

C 1 = SIZE LIMITATION EXCEEDED. 

C 

NERROR = 1 

IF (NCB .GT. 500 .OR. NCB.GT.KAZ .OR. NRB.GT.K8) GO TO 999 
C 

00 AO 1 = 1, NCB 

DO 35 J=I,NCB 

S = ZERO 

00 30 K=1,NRB 

SS = AZ(K,n^B(K,J) 

30 S = S+SS 
35 W(J) = S 

00 40 J=I,NCB 
40 AZ(J,I) = W(J) 

DO 50 1=1 ,NCe 
DO 50 J=I,NCB 
50 AZ(I,J) = AZ<J,n 
RETURN 
C 

999 CALL ZZBOMB ( 6HATXBA1 , NERROR) 

END 
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SUBROUTINE ATXbB ( A, BZ ,NRAT*NRB,NCB,KA tKBZ I 

DIMENSION AlKAtll, BZlKBZtll 

COMMON / LWPKVl / W 1500 1 

DOUBLE PRECISION S,S$,ZERO 

DATA ZERO /O.D/ 

C 

C MATRIX MULTIPLICATION. ACTRANSPOSE) ♦ B = Z. 

C USES TWO WORK SPACES. RESULT IZ) IS PLACED IN B. 

C BZ MUST BE DIMENSIONED LARGE ENOUGH IN MAIN PROGRAM TO CONTAIN THE 
C LARGER OF B OR Z. 

C INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION, 
r. CALLS FORMA SUBROUTINE ZZBOMB. 

C THE MAXIMUM SIZE IS 
C NRAT = 500 

C DEVELOPED BY W A BENFIELD. NOVEMBER 1P71. 

C LAST REVISION BY RL WOHLEN. MARCH 1976. 

C 

C SUBROUTINE ARGUMENTS 

C A = INPUT MATRIX. S IZE (NRB ,NRAT) . 

C BZ = INPUT MATRIX. S IZEI NRB, NCB ) . 

C = OUTPUT RESULT MATRIX. SIZE CNRAT,NCB». 

C NRAT = INPUT NUMBER OF ROWS OF MATRICES AITRANSItZ. MAX=500. 

C NRB = INPUT NUMBER OF ROWS OF MATRIX B, COLS OF MATRIX A(TRANS). 

C NCB = INPUT NUMBER OF COLS OF MATRICES B,Z. 

C KA = INPUT ROW DIMENSION OF A IN CALLING PROGRAM. 

C KBZ = INPUT ROW DIMENSION OF BZ IN CALLING PROGRAM. 

NERROR EXPLANATION 
1 = SIZE LIMITATION EXCEEDED. 

NERP0R=1 

IF (NRAT.GT.500 .OR. NRAT.GT.KBZ .OR. NRB.GT.KBZ> GO TO 999 
C 

DO 40 J=1,NCB 
00 35 1=1, NRAT 
S = ZERO 
DO 30 K=1 ,NRB 
SS = A(K,I)*BZ(K,JI 
30 S = S+SS 
35 W(I) = S 

DO 40 1=1, NRAT 
40 BZ(I,J) = W(I) 

RETURN 

C 

999 CALL ZZeOMB ( 5HATXBB, NERROR I 
END 
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SUBROUTINE ATXBBl ( A» BZ *NRB,NCb,KA,KBZI 
DIMENSION A(KA«1)« PZIKBZ,!) 

COMMON / LWRKVl / W<500) 

DOUBLE PRECISION S.SS.ZERO 
DATA ZERO /O.D/ 

SPECIAL MATRIX MULTIPLICATION. ACTRANSPOSEI ♦ B = Z. 
A IS ASSUMED UPPER TRIANGULAR, SQUARE. 

USES TWO WORK SPACES. RESULT U» IS PLACED IN B. 

INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECIS ION - 
CALLS FORMA SUBROUTINE ZZBOMB. 

THE MAXIMUM SIZE IS 
NRB = 500 

DEVELOPED BY R L WOHLEN AND W A BENFIELD. MAY 1972. 
LAST REVISION BY RL WOHLEN. MARCH 1976- 


SUBROUTINE ARGUMENTS 
A = INPUT MATRIX. S IZE (NRB,NRB I . 

BZ = INPUT MATRIX. S IZ E ( NRB, NCB ) . 

= OUTPUT RESULT MATRIX. SIZE (NRB,NCBI. 

NRB = INPUT NUMBER OF ROWS OF MATRIX 6, SIZE OF MATRIX A(SQUARE). 
MAX=500. 


NCB 

KA 

KBZ 


INPUT NUMBER OF COLS OF MATRICES B,Z. 

INPUT ROW DIMENSION OF A IN CALLING PROGRAM. 
INPUT ROW DIMENSION OF BZ IN CALLING PROGRAM. 


NEPROR EXPLANATION 
1 = SIZE LIMITATION EXCEEDED. 


NERR0R=1 

IF (NRB .GT. 500 .OR. NRB.GT.KBZ) GO TO 999 

C 

DO 40 J = 1,NCB 
DO 35 1=1, NRB 
S = ZERO 
DO 30 K=1,I 
SS = A(K, II=*BZ(K,JI 
30 S = S+SS 
35 W (I) = S 

DO 40 1=1, NRB 
40 BZ(I,J) = W(I) 

RETURN 

C 

999 CALL ZZBOMB ( 6HATXBB1 ,NERROR) 

END 
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SUPROtiTINE ATXPB2 C A.B2 ,NRB ,NCBtKA,KB2l 
DIMENSION A(KA,1I, BZlKBZtl} 

COMMON / LWRKVl / W(50CI 
DOUBLE PRECISION S,SS,ZERO 
DATA ZERO /O.O/ 

C 

C SPECIAL MATRIX MULTIPLICATION. A(TRANSPOSE| *6=2. 

C Z WILL BE SYMMETRIC. UPPER HALF CALCULATED t REFLECTED TO LOWER HALF. 
C USES TWO WORK SPACES. RESULT <Z) IS PLACED IN B. 

C BZ MUST PE DIMENSIONED LARGE ENOUGH IN MAIN PROGRAM TO CONTAIN THE 
C LARGER OF B OR Z. 

C INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

C CALLS FORMA SUBROUTINE ZZBOMB. 

C THE MAXIMUM SIZE IS 
C NCR = 500 

C DEVELOPED BY R L WOHLEN AND W A BENFIELO. MAY 1972- 
C LAST REVISION BY RL WOHLEN- MARCH 1976- 
C 

C SUBROUTINE ARGUMENTS 

C A = INPUT MATRIX. S IZE (NRB,NCB ) . 

C BZ = INPUT MATRIX- SI2E(NRB,NCB) - 

C = OUTPUT RESULT MATRIX. SIZE (NCB,NCE). 

C NRB = INPUT NUMBER OF ROWS OF MATRIX B, COLS OF MATRIX A(TRANS». 

C NCB = INPUT NUMBER OF COLS OF MATRICES B,Z, ROWS OF ACTRANSI. 

C MAX=500. 

;C KA = INPUT ROW DIMENSION OF A IN CALLING PPOGRAM- 

KBZ = INPUT ROW DIMENSION OF BZ IN CALLING PROGRAM. 

NERROR EXPLANATION 
1 = SIZE LIMITATION EXCEEDED. 

NERR0R=1 

IF (NCB. GT. 500 .OR. NCB.GT.KBZ -OR. NRB.GT.KBZI GO TO 999 
C 

DC 40 J=1,NCB 

DO 35 I=ltJ 

S = ZERO 

DO 30 K=1,NRB 

SS = A(K,H*BZ(K,J) 

30 S = S-i-SS 
35 W(I) = S 
DO 40 1=1, J 
PZ(J,II = W(I) 

40 B2(I,J) = W(I) 

RETURN 


999 CALL ZZBOMB ( 6HATXBB2 ,NERROR) 
END 



o r% 


AXBAl 


C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


SUBROUTINF AXBAl ( AZ, B,NR A,NC A,KAZ t KB ) 
DIMFNSIOiN AZCKAZtlJt B(KB,1J 
COMMON# / LWRKVl / W(500) 

DPUBLE PRECISION SfSSfZERO 
DATA ZERC /O.D/ 


MATRIX MULTIPLICATION. A ♦ B = Z. 

MATRIX P IS ASSUMED UPPER TRIANGULAR t SQUARE. 

USES TWO WORK SPACES. RESULT (Z) IS PLACED IN A. 

INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 
CALLS FORMA SUBROUTINE ZZBCMB. 

THE MAXIMUM SIZE IS 
NCA = 500 

DEVELOPED BY P A PHILIPPUS. MAY 1972. 

LAST REVISION BY RL WOHLEN. MARCH 1976. 


SUBROUTINE ARGUMENTS 
AZ = INPUT MATRIX. SIZE (NRA, NCA) . 

= OUTPUT RESULT MATRIX. SI ZE (NRAf NCA ) . 

B = INPUT MATRIX. SIZE(NCA,NCA) . 

NRA = INPUT NUMBER OF ROWS OF MATRICES A,Z. 

NCA = INPUT NUMBER OF COLS OF MATRICES AfZ# SIZE OF B (SQUARE). 
MAX=500. 


KAZ = INPUT ROW DIMENSION OF AZ IN CALLING PROGRAM. 
KB = INPUT ROW DIMENSION OF B IN CALLING PROGRAM. 


NERROR EXPLANATION 
1 = SIZE LIMITATION EXCEEDED. 


NERR0R=1 

IR (NCA .GT. 500) GO TO 999 

DO 40 1=1 fNRA 
DO 20 K=1,NCA 
20 W(K) = AZ(ItK) 

DO 40 J=1,NCA 
S = ZERO 
DO 30 K=1,J 
SS = W(K)*B(K,J) 

30 S = S + SS 
40 AZ(I,J) = S 
RETURN 

999 call Z zee mb (6H AXBAl ,NERROR) 

END 



- -o oonooonon 


AXPA2 


SUBROUTINF AXFA2 (AZtB,NtKAZf KBI 
DIMFNSION AZCKAZtl)* BCKB,1) 

COMMON / LWRKVl / W«500) 

DOUBLE PRECISION StSStZERO 
DATA ZERO /O.D/ 

C 

C MATRIX MULTIPLICATION. A ♦ B = Z. 

C B IS ASSUMED UPPER TRIANGULAR* SQUARE. 

C Z WILL BE SYMMETRIC. LC?WER HALF CALCULATED* REFLECTED TO UPPER HALF. 

C USES TWO WORK SPACES. RESULT CZI ic PLACED IN A. 

C INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

C CALLS FORMA SUBRCUTINE ZZBOMB. 

C THE MAXIMUM SIZE IS 

C N = 500 

C DEVELOPED BY R L WCHLEN AND W A BENFIELD. MAY 1972. 

C LAST REVISION BY RL WOHLEN. MARCH 1976. 

SUBROUTINE ARGUMENTS 
AZ = INPUT MATRIX. SIZE(N,NI. 

= OUTPUT RESULT MATRIX. SIZE(N,N). 

B = INPUT MATRIX. SI2ECN,N). 

N = INPUT SIZE OF MATRICES A*B,Z (SOlfARF). MAX=500. 

KAZ = INPUT ROW DIMENSION OF AZ IN CALLING PROGRAM. 

KB = INPUT ROW DIMENSION OF B IN CALLING PROGRAM. 

NERROP. EXPLANATION 
1 = SIZE LIMITATION EXCEEDED. 

NERR0R=1 

IF (N .GT. 5C0I GO TO 999 

C 

DO AO 1=1 ,N 
DO 20 K=1*I 
20 WIKI = AZ(I,KI 
DO 40 
S = ZERO 
DO 30 K=1,J 
SS = W5K)*B(K,J) 

30 S = S + SS 
AZ(J,II = S 
40 AZn.Jl = S 
RETURN 
C 

999 CALL ZZBOMB (6HAXBA2 .NERRORI 
EM) 
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«:UPROUTINE AXPA3 ( AZ,B,NRB*NC6,KA/ ,KB i 
DIMENSION AZ(KAZvUt 
COMMON / LWPKVl / WC500I 
OOUBIE PRECISION S,SS,ZERO 
DATA ZERO /O.D/ 

MATRIX MULTIPLICATION. A * E = Z. 

A IS ASSUMED UPPER TRIANGULAR, SQUARE. 

USES TWO WORK SPACES. RESULT (Z) IS PLACED IN A. 

A2 MUST PE DIMENSIONED LARGE ENOUGH IN MAIN PROGRAM TO CONTAIN THE 
LARGER OF A *^R Z . 

INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

CALLS FORMA SUBROUTINE ZZPOMB. 

THE MAXIMUM SIZE IS 
NRP = 500 

DEVELOPED BY R L WOHLEN AND WA BENFIELD. MAY 1972. 

LAST REVISION BY RL WOHLEN. MARCH 1976. 

SUBROUTINE ARGUMENTS 
AZ - I'^PUT MATRIX. SIZE(NRB,NRB) . 

= OUTPUT RESULT MATRIX. SIZE (NRB,NCb ). 

6 = INPUT MATRIX. S 12 El NRB,NCB I . 

NRB = INPUT NUMBER OF ROWS OF MATRICES B,Z, SILc OF MATRIX AlSwUARE). 
MAX=500. 

NCB = INPUT NUMBER OF COLS OF MATRICES B,Z. 

KA2 - INPUT ROW DIMENSION OF AZ IN CALLING PROGRAM. 

KB = INPUT ROW DIMENSION OF B IN CALLING PROGRAM. 

NERROR EXPLANATION 
1 = SIZE LIMITATION EXCEEDED. 

NERROR=l 

IF (NRB .GT. 500) GO TO 999 

C 

DO 40 1 = 1 ,NRB 
DO ?0 K=I,NRB 
20 W(K) = AZ(I,K) 

DO 40 J=l,NCE 
S = ZERO 
DO 30 K=I,NRB 
SS = W(K)*B(K,J) 

30 S = S + SS 
40 AZn,J) = S 
RETURN 
C 

999 CALL ZZBOMB (6HAXBA3 , NERROR) 

END 
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SUBROUTINE BABT ( A,B,Z»NRP,NCB,KAtKB) 
DIMENSION A(KA«U, P(KB,1», 2(KB,1) 
COMMON /LWPKVl/ W(500l 
DOUBLE PRECISION StSSsZERO 
DATA ZERO /O.D/ 


SPECIAL TRIPLE MATRIX PRODUCT. B»A»B ( TRANSPOSE ) = 2. 

INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

CALLS FORMA SUBROUTINE ZZfOMb. 

THE MAXIMUM SIZE IS 
NCB = 500 

DEVELOPED BY CARL BCDLEY. JANUARY 1965. 

LAST REVISION BY RL WOHLEN. MARCH 1976. 

SUBROUTINE ARGUMENTS 

A INPUT INNER MATRIX. 51ZE(NCB,NC8» . 

B = INPUT CUTER MATRIX. SI2E(NRP,NCP) . 

2 = OUTPUT RESULT MATRIX. SIZE (NRB,NPB ). 

NRB = INPUT NUMBER OF ROWS OF MATRIX B, SIZE OF MATRIX Z. 

NCB = INPUT NUMBER OF COLS OF MATRIX P, SIZE OF MATRIX A. MAX=500. 
KA = INPUT ROW DIMENSION OF A IN CALLING PROGRAM. 

KB = INPUT ROW DIMENSION OF B,Z IN CALLING PROGRAM. 

NERROR EXPLANATION 
1 = SIZE LIMITATION EXCEEDED. 


NFRRCR=1 

IF (NCB .GT. 500 .OR. NCP .GT. KA .OR. NRB .GT. KB I GO TO 999 

DO 40 J=1,NRB 
DO ?0 L=1 «i CP 
S = ZERO 
DO 10 K-l»NCe 
SS = A(L,K)XcB(J,K ) 

10 s - s+ss 

20 W(L) = S 

DC 40 1=1 ,NRP 
S = ZERO 
00 30 L = 1 .NCB 
SS = B(I,L)«W(L) 

30 S = S+SS 
40 Z(1*J) = S 
RETURN 

999 CALL 2ZBCMB (6HBAET »NERROR) 

END 
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SUPRrUTINf BABTA (AZf B,NREtNCB,KAZtKB » 

DIMENSION AZ(KAZ,l»f 
COMMON /LWRKVl/ W(500) 

DOUBLE PRECISION S,SS,ZERO 
DATA ZERO /O.D/ 

C 

C SPECIAL TRIPLE MATRIX PRODUCT. B*A*B (TRANSPOSEJ = 2. 

C USES TWO WORK SPACES. RESULT {!) IS PLACED IN A. 

C AZ MUST BE DIMENSIONED LARGE ENOUGH IN MAIN PROGRAM TO CONTAIN THE 
C LARGER OF A OP Z. 

C INNER PRODUCT SUMS APE PERFORMED IN DOUBLE PRECISION. 

C CALLS FORMA SUBROUTINE ZZBOMB. 

C THE MAXIMUM SIZE IS 
C NCB = SCO 

C DEVELOPED BY CARL ECDLEY. JULY 1965. 

C LAST REVISION BY RL WOHLEN. MARCH 1976. 

C 

C SUBROUTINE ARGUMENTS 

C AZ = INPUT INNER MATRIX. SIZE(NCBtNCB) . 

C OUTPUT RESULT MATRIX. SIZE (NRB,NRB I . 

C B = INPUT OUTER MATRIX. S IZE< NR.B ,NCB ) . 

C NRB = INPUT NUMBEP OF ROWS OF MATRIX B, SIZE OF MATRIX Z. 

C NCB = INPUT NUMBER OF COLS OF MATRIX B, SIZE OF MATRIX A. MAX=500. 

C KAZ = INPUT ROW DIMENSION OF AZ IN CALLING PROGRAM. 

C KB = INPUT ROW DIMENSION OF E IN CALLING PROGRAM. 

C 

NERROR EXPLANATION 
1 = SIZE LIMITATION EXCEEDED. 

NERRCR=1 

IE (NCB.GT *^00 .OR. NRB.GT.RAZ .OR. NCb.GT.KAZ .OR. NRB .GT. KB) 
^ GO TO 999 

C 

DO 30 1 = 1, NCB 
DO 10 K=1,NCB 
10 W(K) = AZ(I,K) 

DO 30 J=1,NRB 
S = ZERO 
DO 20 K=1,NCB 
SS = W(K)*B(J,K) 

20 S = S + SS 
30 AZ(I,J) = S 
C 

DO 60 J=1,NRB 
DO ^0 K=1 ,NCB 
40 W(K) = AZ(K,J) 

DO 60 1 = 1, NRB 
S = ZERO 
DO 50 K=1,NCB 
SS = B(I,K)«W(K) 

50 S = S+ SS 
60 AZ(I,J) = S 
'' RETURN 

C 

999 CALL ZZBOMB (6HBAETA , NERROR) 
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SUBROUTINE BTAE I A,B ,Z tNRB .NCBtKAB ,KZ) 

DIMENSION A(KAB,1)» BIKABtUt ZtKZfl) 

COMMON /LWRKVl/ WI500) 

DOUBLE PRECISION S,SS,ZERO 
DATA ZERO /O.D/ 

TRIPLE MATRIX PRODUCT. BITRANSPOSE) * A ♦ B = Z. 

INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

CALLS FORMA SUBROUTINE ZZBOMB. 

THE MAXIMUM SIZE IS 
NRB = 500 

DEVELOPED BY RL WOHLEN. FEBRUARY 1965. 

LAST REVISION BY RL WOHLEN. MARCH 1976. 

SUBROUTINE ARGUMENTS 

A = INPUT INNER MATRIX. S IZE ( NRB ,NP B ) . 

B = INPUT OUTER MATRIX. S IZ F{ NRB ,NCB ) . 

Z = OUTPUT RESULT MATRIX. SI ZE (NCB tNCB I . 

NRB = INPUT NUMBER OF ROWS OF MATRIX P, SIZE OF MATRIX A. MAX=500. 

NCB = INPUT NUMBER OF COLS OF MATRIX Pf SIZE OF MATRIX Z. 

KAB = INPUT ROW DIMENSION OF AtB IN CALLING PROGRAM. 

KZ = INPUT ROW DIMENSION OF Z IN CALLING PROGRAM. 

NERROR EXPLANATION 
1 = SIZF LIMITATION EXCEEDED. 

NE PR OR 

IF (NRB. GT. 500 .OR. NRB.GT.KAB .OR. NCB.GT.KZ) GO TO 999 

DO 40 J-1 ,NCB 
DO 20 L=1,NRB 
S = ZERO 
DO 10 K=1 »NRB 
SS = A(L,K>*B (K,J) 

10 S = S + SS 
20 W(L) = S 

00 40 1=1, NCB 
S = ZERO 
DO 30 L=1,NRB 
SS = P(L,I)*W(L) 

30 S = S + SS 
40 Z(T,J) = S 
RETURN 

999 CALL ZZBOMB (6HBTAB , NERROR) 

END 
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SUBROUTINE PTABK A.B,Z,NRB*NCB,KRA,KRB,KRZ) 

COMMON / LWPKVl / V<500) 

DIMENSION A<KRA,1I,B(KRB.1I ,Z(KRZ*1I 
DOUBLE PRECISION SUM, SS, ZERO 

data zero /O.D/ 

BTABl PERFORMS THE OPERATION (Z )=< IB )TRANSP0SEI* (A )* C E 1 . 
BTABl CAN ALSO PERFORM THE OPERATION 

(A)=( (B)TRANSPOSEI*(Al*tB) BY CALL BTABl (A, B , A, — ETC — ) • 
IF S5RB IS NEGATIVE A SYMMETRIC CZl IS COMPUTED. 

MAXIMUM SIZE NRB=500 


INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 


FORMA SUBROUTINE ZZBOMB IS CALLED. 

CODED BY JOHN ADMIRE *NASA* JULY 1972 . 
LAST REVISION BY RL WOHLEN. MARCH 1976. 


A 

B 

Z 

NRB 

NCB 

KRA 

KRP 

KRZ 


AR GUMENTS 

INPUT MATRIX (Al SIZECNRB BY NRB) 

INPUT MATRIX (B) SIZECNRB BY NCB) 

OUTPUT MATRIX (Z) SIZECNCB BY NCB) 

INPUT ABSCNRB) IS THE NUMBER (T ROWS IN CB) 
INPUT NUMBER OF COLUMNS IN CB) 

INPUT ROW DIMENSION OF CA) IN CALLING PROGRAM 

INPUT ROW DIMENSION OF CB) IN CALLING PROGRAM 

INPUT ROW DIMENSION OF CZ) IN CALLING PROGRAM 


NFRROR EXPLANATIONS 
1 = SIZE EXCEEDANCE. 


NR=IABSCNRB) 

NERROR = 1 

IF CNR .GT. f-00 .OR. NR .GT. KRA .OR. NR .GT. KRB 
♦ .OR. NR .GT. KRZ .OR. NCB .GT. KRZ) GO TO 999 
IFCNRB .GT. 0) GO TO 70 
DO 30 1=1 ,NR 
DC 10 K=1,NR 
10 VCK)=ACI,K) 

DO 30 J=1,NCB 
SUM=ZERO 
DO 20 K=1 ,NR 
SS=VCK)»P CK,J) 

20 SUM=SUM+SS 
30 ZCI,J)=SUM 
DO 60 J=1,NCB 
00 40 K = 1 ,NR 
40 VCK)=ZCK,J) 

OP 60 1=1, J 
SUM=ZERP 
DC 50 K=1,NP 
SS = E(K,I )<=VCK) 

50 SUM=SUM+SS 
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60 Z<I»J)=SUM 
DO 63 1=1 ,NR 
DO 63 J=I,NR 
63 Z(J,n=Z(I.J) 

RETURN 

70 DO 100 I=1,NRB 
DO 80 K=lfNRB 
80 V(K»=A(I,K) 

DC 100 J=1,NCB 
SUM=ZERO 
DO «»0 K=1,NRB 
SS=V(K)*BIK,J| 

90 SUM=SUM+S? 

100 Z(I»J»=SUM 

DO 130 J=1,NCB 
DO 110 K=1,NRB 
110 VfKI=Z(K,J) 

DO 130 1=1, NCB 
SUM=ZERO 
DO 120 K=1,NRP 
SS=B(K,I)*V(K} 

120 SUM=SUM+SS 
130 Z(I,J>=SUM 
RETURN 

999 CALL ZZBCMB(6HBTAB1 
END 


,NERRCR| 
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SUBROUTINE BTAPA (AZ* P ,NRP,NCB,KAZtKB ) 

DIMENSION AZ(KAZ,1)» 

COMMON / LWRKVl / W(500) 

OOUPLE PRECISION S,SS,ZERO 
DATA ZERO /O.D/ 

C 

C TRIPLE MATRIX PRODUCT. B(TRANSPOSE» ♦ A * P = Z. 

C USES TWO WORK SPACES. RESULT <ZJ IS PLACED IN A. 

C AZ MUST PE DIMENSIONED LARGE ENOUGH IN MAIN PROGRAM TO CONTAIN THE 
C LARGER OF A OR Z. 

C INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISICS^- 
C CALLS FORMA SUBROUTINE ZZBOMB. 

C THE MAXIMUM SiZcS ARE 
C NRP = 500 

C NCB = 500 

C DEVELOPED BY W A BENFIELD. MaY 1972. 

C LAST REVISION BY PL WOHLEN. MARCH 1976- 
C 

C SUBROUTINE ARGUMENTS 

C AZ = INPUT INNER MATRIX. SIZE(NRB,NRBI . 

C = OUTPUT RESULT MATRIX- SI ZE (NCB ,NCB I . 

C B = INPUT OUTER MATRIX. SIZE(NRB,NCBI . 

C NRP = INPUT NUMFER OF ROWS OF MATRIX 6, SIZE OE MATRIX A- MAX=500- 

C NCB = INPUT NUMBER OF COLS OF MATRIX B, SIZE OF MATRIX 2- MAX=500- 

C KAZ = INPUT ROW DIMENSION OF AZ IN CALLING PROGRAM- 

C KB = INPUT ROW DIMENSION OF 6 IN CALLING PROGRAM. 

NERROR EXPLANATION 
1 = SIZE LIMITATION EXCEEDED. 

NERR0R=1 

IF (NRB.GT.500 -OR. NCB.GT.500 -OR. NRB-GT.KAZ .OR. NCB-GT.KAZl 
♦ GO TO 999 
C 

00 20 I=1»NR6 
DO 5 K=1,NRB 
5 W(KI = AZ(I,K) 

DO 20 J=ltNCB 
S = ZERO 
DO 10 K=1»NRB 
SS = W(K)*B(K,J) 

10 S S + SS 
20 A2(I,J) = S 
C 

DO 30 J=1»NCF 

DO 27 1=1, NCB 

S = ZERO 

DC 25 K=1,NRB 

SS = B(K,n*A2(K,J) 

25 S = S + SS 
27 W(l) = S 

DO 30 l=l,NCfc 
r 30 AZ(T,J) = w(l) 

RETURN 

C 
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999 CALL Z2B0MB (6HBTABA .NERRORl 
END 
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SUPROUTINB PTAEA2 (A2,B,N,KAl 
DIMENSION AZ(KAtU* B(KA»1I 
COMMON / LWRKVl / W(500l 
DOUPLF PRECISION S,SStZERC 
DATA ZERO /0*D/ 

TRIPLE MATRIX PRODUCT. BJTRANSPOSE) ♦ A ♦ P = 2. 

A MUST BE SYMMETRIC TO GET CORRECT ANSWER. 

B IS ASSUMED UPPER TRIANGULAR. 

2 WILL BE SYMMETRIC. UPPER HALF CALCULATED* REFLECTED TO LOWER HALF. 
USES TWO WORK SPACES. RESULT CZ) IS PLACED IN A. 

INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

CALLS FORMA SUBROUTINE 22BOMB. 

THE MAXIMUM SIZE IS 
N = 500 

DEVELOPED BY R L WOHLEN AND W A BENFIELD. MAY 1972. 

LAST REVISION BY RL WOHLEN. MARCH 1976. 

SUBROUTINE ARGUMENTS 
A2 = INPUT INNER MATRIX. SIZE(N,NJ. 

= OUTPUT RESULT MATRIX. SIZEtN.NJ. 

B = INPUT OUTER MATRIX. SI2E(N,N). 

N = INPUT SIZE OF MATRICES A,B,2. MAX=500. 

KA = INPUT ROW DIMENSION OF AZ AND B IN CALLING PROGRAM. 

NERROR EXPLANATION 

I = SIZE LIMITATION OR DIMENSION SIZE EXCEEDED. 

NERRDR=1 

IF (N.GT.500 .OR. N.GT.KAl GO TO 999 

DO 20 1=1, N 
DO 5 K=1,N 
5 W(K) = AZ(I,K) 

DO 20 J=1,N 
S = ZERO 
DO 10 K=1,J 
SS = W(K)=*B(K,J) 

10 S = S ♦ SS 
20 AZ(I,J) = S 

DO 30 J=1,N 

DO 28 1=1, J 

S = ZERO 

DO 25 K=1,I 

SS = B(K,n=FAZ(K,J) 

25 S = S + SS 
28 W(I) = S 
DO 30 1=1 ,J 
AZ(I,J) = W(I) 

30 AZ(J,I) = W(l) 

RETURN 


999 CALL ZZBOMB (6HBTAB A2 ,NERROR| 
END 
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SUBROUTINF BTABCHA»B tCtZtNRB ,NCB tKRA ,KRP tKRC fKRZ) 

DIMENSION A(KRAtl )tB(KRBtl) ,C(KRCyl )«Z(KRZ»1) 

COMMON / LWRKVl / V(500) 

DOUBLE PRECISION SUMySStZERC 
DATA ZERO /O.D/ 

BTABCl PERFORMS THE OPERATION (Z )=( (B ) TRANSPOSE)*! A I ♦( B ) t-IC ) 
BTABCl CAN ALSO PERFORM THE OPERATION 

!C) = ( (E)TRANSPOSE)*(A)*(B) + (C ) BY CALL BTABCl (A, B,C,C,—ETC-“) 
CA)=((E)TRANSP0SE)*(AJ*(B)+(C) BY CALL BTABC1(A,B,C,A,~-ETC — ) 

IF NRB IS NEGATIVE A SYMMETRIC (Z) IS COMPUTED. 

MAXIMUM SIZE NRB=500 

INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

FORMA SUBROUTINE ZZBOMB IS CALLED. 

CODED BY JOHN ADMIRE *NASA* JULY 1972 . 

LAST REVISION BY RL WOHLEN. MARCH 1976. 

ARGUMENTS 

A - INPUT MATRIX (A) *DESTROYED* SIZECNRB BY NRB) 

B - INPUT MATRIX (R) $IZE(NRB BY NCR) 

C - INPUT MATRIX (C ) SI2E(NCP BY NCP) 

Z - OUTPUT MATRIX (Z) SIZE(NCB BY NCB) 

NRB - INPUT ABS(NRB) NUMBER OF ROWS IN (B) 

NCB - INPUT NUMBER OF COLUMNS IN (B) 

KRA - INPUT ROW DIMENSION OF (A) IN CALLING PROGRAM 

KPE - INPUT ROW DIMENSION OF (B) IN CALLING PROGRAM 

KRC - INPUT ROW DIMENSION OF (C) IN CALLING PROGRAM 

KRZ - INPUT ROW DIMENSION OF (Z) IN CALLING PROGRAM 

NERROR EXPLANATIONS 
1 = SIZE EXCEEDANCE. 

NR=IABS(NRB) 

NERROR = 1 

IF(NR .GT. 500 .PR, NR .GT. KRA .OR. NR .GT. KRB .OR. NCB 
* .GT. KPC .OR. NCB .GT. KRZ) GO TO 999 
IFCNRR .GT. 0) GO TO 70 
DO 30 I-1,NR 
DO 10 K=ltNR 
10 V(K)=A(I,K> 

DO 30 J=1,NCB 
SUM^^ZERO 
DO 20 K=1 ,NR 
SS=V(K)*B(K,J) 

20 SUM=^SUM + SS 
30 A(I,J)=SUM 
DO 60 J=1,NCB 
DO -‘►O K = 1 ,NR 
40 V(K)=A(K,J) 

DO 60 1=1 ,J 
SUM=C(If J) 
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DO 50 K=1,NP 
SS=B(K,I)=frVCK» 

50 SUM=SUM+SS 
60 Z(I#J)-SUM 
DO 63 1=1 tNR 
00 63 J=I,NP 
63 Z(J»n=Z(I*J» 

RFTURN 

70 00 100 1=1, NRB 
DO 80 K=1»NRB 
80 V(KI=A(I,KI 
DO 100 J=1,NCE 
SUM=2FP0 
DC 90 K=1,NRB 
SS=V(K)*B(K,J) 

90 SUM=SUM+SS 
100 AfI,J)=SUM 

DO 130 J=1,NCF 
DO 110 K=1,NRB 
110 VtK)=A(K,J) 

DO 130 I=1,NCB 
SUM=C(I,J) 

DO 120 K=ltNRB 
S?;=6(K,n’^V(K) 

120 SUM=SUM+SS 
130 Z(I,JI=SUM 
RETURN 

99S CALL ZZB0MB(6HBTABC1,NERR0R) 
END 



oors ooonr>norvoor>ooor»ooor>on 


ETDBl 


SUBROUTINE BTDBl (D,B, ZfNRB»NCB,KRB,KRZ) 

DIMENSION on l,e<KRB,n,Z(KRZ»ll 
COMMON / LWRKVl / V(500l 
DOUBLE PRECISION SUM, SS, ZERO 
DATA ZERO /O.O/ 

BTOBl PERFORMS TOE OPERATION (Z I = ( (B ITRANSPOSEM-0-l*(BI 
WHERE (-0-) IS A DIAGONAL MATRIX AND THE INPUT VECTOR (D> 

contains the diagonal elements . 


MAXIMUM SIZE NnP=^500 

INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

FORMA SUBROUTINE ZZBOMB IS CALLED. 

CODED BY JOHN ADMIRE ♦NASA* JULY 1972 . 

LAST REVISION BY RL WOHLEN. MARCH 1976. 


D 

e 

Z 

NRB 

NCB 

KRP 

KRZ 


ARGUMENTS 

INPUT VECTOR CONTAINING THE DIAGONAL ELEMENTS OF 
INPUT MATRIX (B ) SIZE(NRB BY NCB) 

OUTPUT MATRIX (Z) SIZE(NCB BY NCB) 

INPUT ABS(NRB) NUMBER OF ROWS IN (B) 

INPUT NUMBER OF COLUMNS IN <B> 

INPUT ROW DIMENSION OF (B) IN CALLING PROGRAM 

INPUT ROW DIMENSION OF IZI IN CALLING PROGRAM 


NERROR EXPLANATIONS 
1 = SIZE EXCEEDANCE. 


NR=IABS(NRB) 

NERROR = 1 

IF (NR .GT. 500 .OR. NR .GT. KRB .OR. NCB .GT. KRZ) GO TO 999 
DO 30 J=1,NCB 
00 10 K-I,NR 
10 V(K)=D(K)*R(K,J) 

DO 30 1=1 ,J 
SUM=ZERO 
DO 20 K=1NP 
SS=P(K,I )*V(K) 

20 SUM=SUM+SS 
30 Z(I,J)=SUM 
DO 33 1=1, NR 
DO 33 J=I,NR 
33 Z( J,I)=Z( 1,J) 

RETURN 

999 CALL ZZBOMB (6hPTDBl , NERROR) 

END 
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SUBROUTir^E BTDBCl <P ,B ,C ,2 tNRB tNCB.KRB ,KRC *KR2 ) 

DIMENSION DCl) ,BIKRb,l),CIKRCfl),2(KRZf 1) 

COMMON / LWRKVl / V<500) 

DOUBLE PRECISION SUM.SS 

BTDBCl PERFORMS THE OPERATION ( Z )- ( (B ITRANSPOSE )♦ B 1 +(C ) 
i^HERE (-D-) IS A DIAGONAL MATRIX AND THE INPUT VECTOR IS)) 

CONTAINS THE DIAGONAL ELEMENTS • 

BTDBCl CAN ALSO PERFORM THE OPERATION 

(C) = < <B)TRANSPOSE)*l-D-)<‘{B) + (C) BY CALL BTDBC1(0,B,C,C, — ETC — I 
IF NRB IS NEGATIVE A SYMMETRIC 121 IS COMPUTED- 
MAXIMUM SIZE NRB=500 

INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

FORMA SUBROUTINE 2ZBOMB IS CALLED. 

CODED BY JOHN ADMIRE ♦NASA* JULY 1972 . 

LAST REVISION BY RL WOHLEN. MARCH 1.976. 


D 

— 

INPUT 

B 

- 

INPUT 

C 

- 

INPUT 

z 

- 

OUTPUT 

NRB 

- 

INPUT 

NCB 

- 

INPUT 

KRB 

- 

INPUT 

KRC 

- 

INPUT 

KRZ 


INPUT 


ARGUMENTS 

VECTOR CONTAINING THE DIAGONAL ELEMENTS OF {-D-) 
MATRIX IB) SIZECNRP BY NCB) 

MATRIX (C) SIZE (NCB BY NCB) 

MATRIX IZ) SIZEINCB BV NCB) 

ABS(NRB) NUMBER OF ROWS IN (BI 

NUMBER OF COLUMNS IN IB) 

ROW DIMENSION OF (B) IN CALLING PROGRAM 

ROW DIMENSION OF (C) IN CALLING PROGRAM 

ROW DIMENSION OF CZ) IN CALLING PROGRAM 


NFRROR EXPLANATIONS 
1 = SIZE EXCEEDANCE. 


NR=IABS(NRB) 

NERROR = 1 

IF (NR ,GT. 500 .OP. NP .GT. KRB .OR. NCB .GT. KRC 
♦ .OR. NCB .GT. KR2) GO TO 999 
IF(NPB .GT. 0) GO TO 40 
DO 30 J=1,NCB 
on 10 K = 1 ,NR 
10 V(K)-D(K)*P IK,J) 

00 30 I=lfJ 
SUM=C(1,J) 

DO 20 K=1 ,NR 
SS=P(K»I )*VIK) 

20 SUM=SUM+S£ 

30 Z(IfJ)=SUM 
DO 33 1=1. NR 
DO 33 J=I,NR 
33 Z( J.I)=Z(IfJ) 

RETURN 

40 DC 70 J=1,NCB 
DO 50 K=1.NR 
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50 V(K>=DCK)*P(K,J» 

00 70 I=ltNCB 
SUM=C(lf J ) 

DO 60 K=1 ,NP 
SS=B(K,n*V(K) 

60 SUM=SUM+SS 
70 2<ItJ)=SUM 
RFTURN 

999 CA*.', ZZB0MB<6HBT0BCltNERR0R) 
ENl 
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SUBROUTINE CCLMLT ( AVEC tB ,7. ,NR ,NC fKRl 
DIMENSION AVECfl), 6(KRtl)» ZlKRtl) 

C 

C MULTIPLY EACH ELEMENT IN COLUKN(Ji OF MATRIX B BY 
C ELEMENTtJ) PF VECTOR AVEC. 

C MATRICES B*7 MAY SHARE SAME CORE LOCATIONS. 

C CODED BY RL WCHLFN. FEBRUARY 1965. 

C 

C SUPSrUTlNE ARGUMENTS 

C AVEC = INPUT VECTOR. SIZE (NCI. 

C B = INPUT MATRIX. SIZE(NR,NC). 

C Z = OUTPUT RESULT MATRIX. SIZE(NR,NCI. 

C NR = INPUT NUMBER OF ROWS IN MATRICES BfZ. 

C NC = INPUT NUMBER OF COLS IN MATRICES B,2. ELEMENTS IN VECTOR AVEC. 

C KR = INPUT ROW DIMENSION OF B,Z IN CALLING PROGRAM. 

C 

DO 10 1=1, NR 
DO 10 J=1,NC 

10 2(1, J) = AVEC(J) * B(I,JI 
RETURN 
END 
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SUBROUTINE COMENT 
DIMENSION IRFMRKU?) 

COMMON /LLINE/ NLINE,MAXLIN,MINI 
DATA NIT, NOT/5, 6/ 

C 

C READ COMMENT CAROS AND PRINT THEM UNDER PAGE HEADING OF FORMA 
C SUBROUTINE PAGEHD. COMMENT CARDS MAY HAVE ANY KEYPUNCH SYMBOL 
C IN CARD COLUMNS 1-78. 

C IF IT IS DESIRED TO HAVE ANY GIVEN COMMENT CARD PRINT ON A NEW 
C PAGE, SUPPLY THE LETTEP P IN COLUMN 80 ON THAT CARO. 

C ROUTINE IS ENDED BY SUPPLYING A CARD WITH ZEROS IN COLUMNS 1 THRU 10. 
C CALLS FORMA SUBROUTINE PAGEHD. 

C CODED BY PF HRUDA. MARCH 1966. 

C LAST REVISION BY RL WOHLEN. MARCH 1976. 

C 

1001 FORMAT (13A6,1X,A1) 

2001 format (///> 

2002 FORMAT (22X,13A6) 

2050 FORMAT (/ IX 123 (1H-) ) 

C 

N = 0 

1 READ (NIT, icon ( IREMRK (I 1 , 1 = 1, 13 ) , IPGHD 
IF (IREMRKdJ .EQ. 6H000000I RETURN 

N = N+1 

IF (N.NF.l .AND. IPGHO.NE .IHP I GO TO 2 
IF (MINI .NE. AHMINII GO TO 800 

IF (NLINE .LE. 5 .OR. NLINE .GE. MAXLINI GO TO 800 
IF ((NLINF+21 .GT. MAXLIN) GO TO 80C 
WRITE (NOT, 20 50 1 
NLINE = NLINE + 2 
GO TO eio 
800 CALL PAGEHD 
810 WRITE (NOT, 2001) 

NLINE = NLINE ♦ 3 
N = 1 

2 IF ((N+8) .EQ. MAXLIN) N = 0 
WRITE (NOT, 2002) ( IREMRK( I) , 1=1 , 13 ) 

NLINE = NLI^E + 1 

GO TO 1 
END 
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SUBROUTINE COMPAR ( A,R,NR ,NC,ND1G,GT0L,ANAME,RNAME,KA,KR1 
DIMENSION A(KAtl)« PCKR.l) 

COMMON /LLINE/ NL1NE,MAXLIN,MINI 
DATA EPS/C. 0/ 

DATA NIT,NCT/5t6/ 

C 

C COMPARE TWO MATRICES ELEMENT BY ELEMENT. PRINT OUT ELEMENT DATA WHEN 
C ELEMENTS DO NOT COMPARE TO SPECIFIED NUMBER OF DIGITS (NDIG). 

C ELEMENT VALUES BELOW TOLERANCE (GTOLI ARE IGNORED. 

C A MAXIMUM OF 1000 NONCOMPARABLE ELEMENTS ARE PRINTED. 

C DEVELOPED EY JW ERNST, RL WOHLEN. OCTOBER 1971. 

C LAST REVISION BY RL WOHLEN. MARCH 1976. 

C 

C SUBROUTINE ARGUMENTS (ALL INPUT) 

C A = MATRIX TO BE CHECKED. SI2E(NR,NCI. 

C R = MATRIX containing REFERENCE VALUES. SIZE(NR,NCI. 

C NR = NUMBER OF ROWS OF MATRICES A,R. 

C NC = NUMBER OF COLS OF MATRICES A,R. 

C NOIG = NUMBER OF DIGITS TO BE COMPARED BETWEEN (A) AND (R). 

C GTOL = garbage TOLERANCE. MATRIX ELEMENTS (ABS) LESS THAN OR 
C EQUAL TO THIS VALUE WILL BE IGNORED. 

C ANAME = NAME OF MATRIX A. 

C RNAME = NAME OF MATRIX R. 

C KA = ROW DIMENSir^ OF A IN CALLING PROGRAM. 

C KR - ROW DIMENSION OF R IN CALLING PROGRAM. 

C 

2001 FORMAT (/// lOX 34HSUBR0UTINE COMPAR COMPARES MATRIX ,A6, 

Ji- 21H TO REFERENCE MATRIX ,A6,20H ELEMENT BY ELEMENT. 

♦ / A4X 6H , 2 IX 6H , 

♦ / lOX 25HELEMENTS ARE COMPARED TO ,12, lOH DIGITS. 

♦ 24HELEMENTS (ABS) LESS 7HAN.E10.3, 13H ARE IGNORED. 

♦ / 35X 2H — , 35X 9H ) 

2002 FORMAT ( / 15X 48H0 IS AGREEMENT WAS FOUND AT THE FOLLOWING ELEMENTS 

♦ / IFX IHI, 3X IHJ, 6X 7HMATRIX ,A6, 5X IIHREF MATRIX ,A6) 

2003 FORMAT (15X 2IA^, 2E19.8) 

2004 FORMAT ( / I5X 7HMATR IX ,A6, 30H AGREES WITH REFERENCE MATRIX ,A6) 

2005 FORMAT ( / lOX 25HEND OF SUBROUTINE COMPAR.) 

C 

WRITE (NOT, 2001) ANAME, RNAKE, NDIG, GTOL 
NLINE = NLINE ♦ 7 
ATOL = 10.**(~NDIG) 

NEL = 0 
DP ?0 J=1 ,NC 
DO 20 1 = 1, NR 

IF (APS(A(I,J)).LE.GTOL .AND. ABS (R ( I ,J ) ) .LE .GTOL ) GO TO 20 
IF (ABS(R(I,J)) .LE. EPS) GC TO 10 

IF (ABS((A(I,J)-R(1,J))/R(I,J)) .LE. ATOL) GO TO 20 
10 IF (NEL .EO. 0) WRITE (NOT, 2002) ANAME, RNAME 
NLINE = NLINE ♦ 3 
NEL = NEL<1 

IF (NEL .GT. 1000) GO TO 3C 
WRITE (NOT, 2003) 1 , J, A( 1 , J) ,R ( 1, J ) 

NLINE = NLINE + 1 
20 CONTINUE 

IF (NEL .EO. 0) WRITE (N0T,2004) ANAME, RNAME 
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NLINE = NLINF ♦ 2 
30 WRITE (NOT, 20051 
NLINE = NLINE + 2 
RETURN 
END 
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SUBROlfTINr DPUD,P,Z,NPP,NCB,KRB»KRZI 
DIMENSION 0(n,BIKRB,l),ZCKRZ,ll 


OBI PERFORMS THE OPERATION (Z) = (-. I’MPI 

WHERE 0 IS A VECTOR THAT CONTAINS THE DIAGONAL ELEMENTS OF (-0-1 

DPI CAN ALSO PERFORM THE OPERATION 

(B) = (-D-)*(EI EY CALL OBKB.B, — ETC — ) 

IF NRP IS NEGATIVE AND ABS(NRB) IS EQUAL TO NCB 
A SQUARE, SYMMETRIC (Zl IS CALCULATED. 

FORMA SUBROUTINE ZZBOMB IS CALLED . 

CODED PY JOHN ADMIRE *NASA* JULY 197? . 

LAST REVISION BY RL WOHLEN. MARCH 1976. 


D 

P 

Z 

NRP 

KRP 

KRZ 


ARGUMENTS 

INPUT A VECTOR THAT CONTAINS THE DIAGONAL ELEMENTS OF (-D-) 
INPUT MATRIX (B ) SIZEINPP BY NCB) 

OUTPUT MATRIX (Z) S12E(NRB BY NCB) 

INPUT APS(NRB) IS THE NUMBER OF ROWS IN (B) 

INPUT ROW DIMENSION OF (P) IN CALLING PROGRAM 

INPUT ROW DIMENSION OF (Z) IN CALLING PROGRAM 


NERROR EXPLANATIONS 

1 = SIZE EXCEEDANCE. 

2 = NON-SQUARE RESULT ASKED FOR. 


NR=IAPS<NPB) 

NERROR = 1 

IF(NR .GT. KRB .OR. NR .GT. KRZ) GO 10 999 
IF(NRB .GT. 0) GO TO 20 

NERROR = 2 

IF(NR .NE. NCB) GO TO 999 
DO 10 J=1,NR 
DO 10 1=1, J 
Z( I,J)=D(I)«B(1,J) 

10 Z(J,I)=Z( I,J) 

RETURN 

20 DP 30 J=1,NCB 
DO 30 1 = 1, NRP 

30 Z(I,J)=0( I)*B(I,J) 

RETURN 

999 CALL ZZBOMB (6HDB1 
END 


, NERROR ) 
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C 

C 

C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

i: 


c 




SUBROUTINE DCOMl (A,Z,N,KR) 

DIMENSION A(KR,1)» 2(KRtl) 

DOUBLE PRECISION DM,DS 
DATA Et>S/ 0.0 / 

DATA NIT, NOT/5, 6/ 

DECOMPOSE MATRIX (A) TO FORM UPPER TRIANGULAR MATRIX (Z) SUCH THAT 
A = Z (TRANS) » 2. CHOLESKI SQUARE ROOT METHOD. 

MATRIX (A) SHOULD BE REAL, SQUARE, SYMMETRIC, POSITIVE DEFINITE. 
UPPER HALF OF MATRIX (A) IS USED. 

MATRICES (A) AND (Z) MAY SHARE SAME CORE LOCATIONS. 

INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

CALLS FORMA SUBROUTINE ZZBOMB. 

CODED BY PL WOHLEN. OCTOBER 1970. 

LAST REVISION BY RL WOHLEN. MARCH 1976. 

SUBROUTINE ARGUMENTS 

A = INPUT MATRIX TO BE DECOMPOSED. SIZE(N,N). 

2 = OUTPUT MATRIX. SI2E(N,N). 

N = INPUT SIZE OF MATRICES A,Z. 

KR = INPUT ROW DIMENSION OF A, 2 IN CALLING PROGRAM. 

NERROR EXPLANATION 

1 = MATRIX IS NON-POSITIVE DEFINITE AT A(l,l). 

2 = MATRIX IS NON-POSITIVE DEFINITE. 

3001 FORMAT (5H1I = 13) 

NERR0R=1 

IF (A(l,l) .LE. EPS) GO TO 999 
Z(l,l) = SQPT(A(1,D) 

IF (N .EQ. 1) RETURN 
DC 5 J=2,N 

5 Z(1,J) = A(1,J)/Z(1,1 ) 

NERR0R=2 

DO 30 1=2, N 
IMl = I-l 
IPl = I-H 
DS = A(I,I) 

DO 10 K=1 ,IM1 
DM = Z(K,I)**2 
10 OS = ns - DM 
Z(I,I) = DS 

IF (Z(I,I) .LE. EPS) GO TO 998 
Z(I,I) = SQRT(Z(I,D) 

IF (I .EO. N) GO TO 90 
DO 30 J=IP1,N 
OS = A( I, J) 

DO 20 K=1,IM1 
DM = Z (K, I )#Z (K,J ) 

20 DS = DS - DM 
Z(I,J) = DS 

30 Z(I,J) = Z(I,J)/Z(1,I ) 


C 



DCOMl 


40 DO 50 1=2 »N 
IMl = I-l 
DO 50 J=1,IM1 
50 = 0,0 

RETURN 

998 WRITE (NOT, 3001) 1 

999 CALL ZZBOMB (6HDCCM1 ,NERROR| 
END 
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SUBROUTINE DIAG I AVEC ,Z ,N ,KR1 
DIMENSION AVECdl, 2IKR,I) 

DIAGONALIZE A VECTOR IROW OR COLUMN MATRIXI INTO A SQUARE MATRIX. 
CODED BY RL WOHLEN. FEB 1965. 

SUBROUTINE ARGUMENTS 
AVEC = INPUT VECTOR. SIZEfN). 

2 = OUTPUT RESULT MATRIX. S1ZF(N,N). 

N = INPUT SIZE OF MATRIX Z (SQUARE I, LENGTH OF VECTOR AVEC. 

KR = INPUT ROW DIMENSION OF Z IN CALLING PROGRAM. 

DO 20 1=1 ,N 
DO 10 J=1,N 
10 Z(I,JI = 0.0 
20 2(1, n = AVECdl 
RETURN 
END 



ooooonnoonnoooooooooo 


DIFFl 


SUBROUTINF DIFFl (XA, XZ , YA, 2,NXA,MXZ,NCA,KA ,KZ I 
DIMENSION XAUl.XZm tYA«KA,l IfZIKZt 1 1 

LINEAR DIFFERENTIATION. 

VALUES OF XZ MAY FE OUTSIDE OF XA. (EXTRAPOLATION*. 

CODED BY RF HRUOA. SEPTEMBER 1965. 

LAST REVISION BY J ERNST, OCT 1973. 

SUBROUTINE ARGUMENTS 

XA = INPUT VECTOR OF X-COORD INATES FOR ROWS OF YA. MUST BE IN 

INCREASING ORDER. SIZE(NXA|. 

XZ = INPUT VECTOR OF X-COORD INATES FOR DERIVATIVES. SIZECNXZI. 

YA = INPUT MATRIX OF Y-COORD INATES TO BE DIFFERENTIATED. 

SIZE(NXA,NCAI . 

Z = OUTPUT MATRIX OF DERIVATIVES. SIZE (NX2 ,NCA > . 

EACH COLUMN OF 2 HAS DERIVATIVES OF THE RESPECTIVE 
COLUMN OF YA. 

NXA = INPUT NUMBER OF XA STATIONS, ROWS OF MATRIX YA. 

NXZ = INPUT NUMBER OF XZ STATIONS, ROWS OF MATRIX Z. 

NCA = INPUT NUMBER OF COLUMN VECTORS IN MATRICES YA,Z. 

KA = INPUT ROW DIMENSION OF YA IN CALLING PROGRAM. 

KZ = INPUT ROW DIMENSION OF Z IN CALLING PROGRAM. 

DC 30 K=1,NXZ 
DC 10 1=1, NXA 

IF(XZ(KI.LE.XA{H^1» .OR. ( I^^l J .EC.NXA I GO TO 20 
IG CONTINUE 
20 DO 30 J=1,NCA 

30 ii(K,J> = (YA(I^^1,J)-YA(I,J) )/(XA{I + l)-XA(in 

RETURN 

END 
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SUBROUTINE DIFF2 (X A. X2 , YA, 2 f NXAtNXZt NC A| KA ,KZ > 

DIMENSION XA(1),XZ(1J ,YA(KA,l),Z(KZ*n 

DIPARABOLIC DIFFERENTIATION. 

CPARAPOLIC DIFFERENTIATION IN FIRST, LAST BAYS AND OUTSIDE XA). 
VALUES OF XZ MAY BE OUTSIDE OF XA. (EXTRAPOLATION). 

CALLS FORMA SUBROUTINE ZZBOMB. 

COOED BY RF HRUDA. FEBRUARY 1965. 

LAST REVISION BY WA BENFIELD. MARCH 1976. 

SUBROUTINE ARGUMENTS 

XA = INPUT VECTOR OF X-COORD INATE S FOR ROWS OF YA. MUST BE IN 

INCREASING ORDER. SIZE(NXA). 

XZ - INPUT VECTOR OF X-COCPD INATES FOR DERIVATIVES. SIZE(NXZ). 

YA = INPUT MATRIX OF Y-CCORD INATES TO BE DIFFERENTIATED. 

SIZE (NXAtNCA) . 

Z = OUTPUT MATRIX OF DERIVATIVES. SI ZE (NXZ ,NCA ) . 

EACH COLUMN OF Z HAS DERIVATIVES OF THE RESPECTIVE 
COLUMN OF YA. 

NXA = INPUT NUMBER OF XA STATIONS, ROWS OF MATRIX YA. 

NXZ = INPUT NUMBER OF XZ STATIONS, ROWS OF MATRIX Z. 

NCA = INPUT NUMBER OF COLUMN VECTORS IN MATRICES YA,Z. 

KA = INPUT ROW DIMENSION OF YA IN CALLING PROGRAM. 

KZ = INPUT ROW DIMENSION OF 2 IN CALLING PROGRAM. 

NERRCIR EXPLANATION 
1 = LESS THAN 3 STATIONS. 

NEPROR = 1 

IF (NXA .LT. 3i GO TO 999 
DO 400 K-1,NXZ 

IF (XZ(K) .LE.XA(2)) GO TO 100 
IF (XZ(K) .GE.XA(NXA-l)) GO TO 300 
DO 50 1=3, NXA 

IF (XZ(K).LE.XA(I)) GO TO 200 
50 CONTINUE 

FIRST BAY CR LEFT EXTRAPOLATION. 

100 PAYL = XA(?)-XA(1) 

H = (XZ (K)-XA(l) )/EAYL 
0 = (XA(3)-XA(1))/BAYL 
DC 10? J=1,NCA 

102 Z(K,J)=( YA(1,J)«(2.0*H-1.C-D)/D 

♦ +YA(2 tJ)# (2.0*H-D)/(1 .0-0) 

♦ +YA(3,J)=F(-2.0*H+1,0)/(D-D**2) )/BAYL 
GO TO 400 

INTERIOR BAY. 

200 BAYL = XA(I)-XA(1-1 ) 

H = (XZ(K) -XA( I-l n /E AYL 
C = (XA( I-2)-XA( I-l ))/BAYL 
^ D = (XA(I + 1 )-XA(I-l n/BAYL 

DC 202 J=1,NCA 

202 Z(K,J) = ( YA(I-2,J )=M3 .0*H+*2-4.0*H-H.0)/(C-C*»2) 
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♦ ♦YAn-l*Jl*l3.0*H*^2»<C-0l+2.0*H»C2.0»D“C)-0*n .♦cn/<c*o) 

♦ +YA(I ,J)«(3.0*H»*2*(D-C)+2«0*H*(1.0-2.0=«)+CI-C»(l-0--011/ 

♦ m-o-c)*(i.o~on 

♦ ♦YA(I+l,J>t'(-3.'"*H**2+2.0*H)/(D-D=*»2l )/BAYL 
GO TO 400 

LAST PAY OR RIGHT EXTRAPOLATION. 

300 BAYL = XA(NXA)-XA(NXA-I) 

H = (XZ(K» -XA(NXA-I n/BAYL 
C = (XA(NXA-?)-XA(NXA-Il)/BAYL 
DO 302 J=1,NCA 

302 Z(K»JI = ( YA(NXA-2,J)»(-2.0*H-H.0»/(C-C**2) 

♦ +YA(NXA-1,J)*(2.0*H-1.0-CI/C 

« +YAINXA ,J J=i'C2.0*H“CI/(1.0-C» l/BAYL 

400 CONTINUE 
RETURN 

999 CALL ZZBOMB (6HDIFF2 .NERRORJ 
END 
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SUPRnUTlNf DISA ( At IR A t JC A, Z.NRAt NCA*NRZ»NC Zt KRA,KRZ ) 

1 DIMENSION AIKRAtll* Z(KRZ,1) 

C 

C MATRIX DISASSEMBLY. (MATRIX Z FROM MATRIX Al. 

C CALLS FORMA SUBROUTINE ZZBOMB. 

C CODED BY P.L WCHLEN. FEB 1965. 

C LAST REVISION BY WA BENFIELD. MARCH 1976. 

C 

C SUBROUTINE ARGUMENTS 

C A = INPUT MATRIX. S1ZE(NRA,NCA) . 

C IRA = INPUT ROW NUMBER IN MATRIX A OF FIRST ROW OF MATRIX Z. 

C JCA = INPUT CCL NUMBER IN MATRIX A OF FIRST COL OF MATRIX Z. 

C Z = OUTPUT RESULT MATRIX. SI ZE (NRZ .NCZ ) . 

C NP.A = INPUT NUMBER OF ROWS OF MATRIX A. 

C NCA = INPUT NUMBE'' OF COLS OF MATRIX A. 

C NRZ = INPUT NUMBER OF RC!WS OF MATRIX Z. 

C NCZ = INPUT NUMBER OF COLS OF MATRIX Z. 

C KRA = INPUT ROW DIMENSION OF A IN CALLING PROGRAM. 

C KRZ = INPUT ROW DIMENSION OF Z IN CABLING PROGRAM. 

C 

C NERROR EXPLANATION 

C 1 = LOOKING FOR DATA OUTSIDE OF MATRIX A ROWS- 
C 2 = LOOKING FOR DATA OUTSIDE OF MATRIX A COLUMNS. 

C 

NERROR = 1 

IF ((IRA-l+NRZ) .GT. NRA) GO TO 999 

NERROR = 2 

IF ((JCA-l+NCZ) «GT. NCA) GO TO 999 
C 

DO 10 IZ=1,NRZ 
lA = IZ + IRA - 1 
DO 10 JZ=1,NCZ 
JA = .JZ ♦ JCA - 1 
10 Z(IZ,JZ) != A(IA,JA) 

RETURN 

C 

999 CALL ZZBOMB (6HDISA , NERROR) 

END 
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SUBROUTINE EIGNl ( A, VALt VEC,NIN,FODIN,KR) 

DIMENSION A(KR,1), VALfDt VEC(KR,1I 
DATA NIT,NOT/5,f>/ 

CALCULATE EIGENVALUES / EIGENVECTORS OF (AHVECI = IVECH-VAL-). 
JACOBI METHOD, THRESHOLD VERSION. PROGRESS FROM PIVOT ELEMENT 
(IPIVOT,JPrVOT) TO ELEMENT IIPIVOT, JPl VCT+I ) AFTER A PIVOT. 

THE (Al MATRIX SHOULD BE REAL, SYMMETRIC. UPPER HALF IS USED. 

CALLS FORMA SUBROUTINE 2ZBOMB. 

COOED BY RL WOHLEN. APRIL 1969. 

LAST REVISION BY RL WOHLEN. JANUARY 1975. 

SUBROUTINE ARGUMENTS 

A = INPUT MATRIX TO BE DIAGONALIZED. SIZE(N,N). ^DESTROYED* 

VAL = OUTPUT VECTOR OF EIGENVALUES. SIZE(N). 

VEC = OUTPUT MATRIX OF EIGENVECTORS. SIZE(N,N). 

NIN = INPUT ABS(NIN:=N IS THE SIZE OF MATRICES A, VEC, VECTOR VAL. 

IF NIN IS NEGATIVE, INITIAL VEC MATRI^: IS ASSUMED TO 
EE SUPPLIED FROM ARGUMENT. 

FODIN = INPUT FINAL OFF-DIAGONAL VALUE FOR DIAGONALIZED A. 

IF FODIN .LF. 0., FOO=TRACE ( A WILL BE USED. 

KR = INPUT ROW DIMENSION OF A, VEC IN CALLING PROGRAM. 

NERROR EXPLANATION 

1 = SUM OF THE DIAGONALS IS NOT POSITIVE. 

2001 FORMAT (//// 54X ,18H( SUBROUTINE EIGNl) I 

2002 FORMAT (//41X ,26HF1NAL OFF-DIAGONAL CFOO) =E10.3, 8H (INPUT)) 

2003 FORMAT (//39X ,26HFINAL OFF-DIAGONAL CEOD) =Ei0.3,13H (CALCULATED)) 
C 

N = lABS(NIN) 

IF (NIN .LT. 0) GO TO 10 
C SET INITIAL VEC MATRIX TO UNITY. 

DO 6 1=1, N 
DO 5 J=1,N 

5 VEC(I,J) = 0.0 

6 VEC (I, I ) = 1.0 
C 

10 IF (N .EQ. 1) GO TO 60 
C 

C FIND LARGEST OFF-DlAGONAL ELEMENT (THRESH) OF A. 

C CALCULATE SUM OF DIAGONALS (TRACE) OF A. 

TRACE = 0. 

THRESH = AES( A(l,2) ) 

NMl = N-1 

DO 15 1=1, NMl 

TRACE = TRACE + A(I,I) 

IPl = I+l 
DO 15 J=IP1,N 

15 IF (APS(A(I,J)) .GT. THRESH) THRES!!=ABS ( A( I , J ) ) 

TRACE = TRACE ♦ A(N,N) 

FuD = rODIN 

IF (FODIN ,LE. 0.) F0D=TRACE#1 .E-2 1 
WRITE (NOT, 2001) 

IE (FODIN .GT. 0.) WRITE (NOT ,2002) ECO 
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IK IFODIN -LE- 0.1 WRITE (N0l,2003) FOO 

NERRCR=1 

IF (FDD .IE. O.) GO TO 999 
IF tTHRESH .LE. FOO » GO TO 60 

C 

C SCAN UPPER OFF-0 1 AGONAL ELEMENTS OF MATRIX A BY ROWS UNTIL A VALUE 
C GREATER THAN THRESH IS FOUND. PIVOT ON THIS ELEMENT 
20 THRESH = THRESH/10. 

IF (THRESH .LT. FOD » THRESH=FOD 
22 IRELO = 0 

DO 41 IP=1,NM1 
IPMl = lP-1 
IPPl = IP+1 
0. 40 JP=IPP1,N 

IF (APS(A (IP,JP) ) .LT. THRESH) GO TO 40 

IREOC = 1 

C CALCULATE POTATION VALUES. 

DEL = A(IP,I?) - A(JP,JP) 

RAO = SORT (DEL**2 + 4.*A ( IPt JP I 

IF (DEL .LT. 0.) PAD=-RAO 

TN = (2. ♦ A(IP,JP)) / (DEL ♦ RAD) 

CS = 1. / SORT (1. + TN**2) 

SN = TN ♦ CS 

C DIAGONALIZE MATRIX (A). ONLY UPPER HALF IS USED. 

JPMl = JP-1 
JPPl ^ JP+1 

IF (IP .FQ. 1 ) GO TO 33 
DO 32 1=1 ,IPM1 

AI:P = A(ltIP)’*CS + A(I,JP)*SN 

A(IfJP) =-A(I,lP)*SN + A(I,JP)#CS 

32 A(I.IP) = AIIP 

33 IF (IPPl .FO. JP) GO TO 35 
DO 34 I=IMP1,JPM1 

AIPI = A(IP,I)^C5 + A(I,JP)*SN 

A(I,JP) =-A(IP,I)4SN * A(I,JP)*CS 

34 A(IP»1) = AIPI 

35 IF (JP .FO. N) GO TO 37 
00 36 1=JPP1»N 

AIPI = A(IP,I)«C5 + A(JP»I)*SN 

A(JPtl) =-A(IP,I)#SN + A(JPfl)*CS 

36 A(IP,1) = AIPI 

37 AIPIP = A(IP.IP) 

AJPJP = A(JRtJP) 

CS2 = C5»*2 

SN? = SN**2 

aSC = ?.«A(IP,JP)’»SN’«‘CS 

A(IP,IP) = A1PIP*CS2 + ASC + AJPJP^^SN? 

A(JP»JP) = AIPIP’^SNZ - ASC ♦ AJPJP»CS2 
A(IP,JP) = 0.0 
C CALCULATE EIGENVECTORS. 

DO 38 1 = 1 ,N 

VFCIIP = VFC(lfIP)*C5 + VFC(I,JP)’^SN 
VEC(T,JP) =-VEC(l ,IP)*SN + V£C(1,JP)*CS 

38 VECdtIP) = VECIIP 
40 CONTINUE 



n o 


41 CONTINUE 

IP (TREDO .EC. 1) GC TO 22 
IP (THRESH .GT. EOD) GO TO 20 

PLACE DIAGONAL FROM A INTO VAL (EIGENVALUES). 

60 DO 61 1=1, N 

61 VAL(l) = Ad, I) 

RETURN 

999 CALL Z2BCMP (6HEIGN1 .NERROR) 

END 
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S'JPfJOUTIME EIGNIA ( A» VALt VEC,NIN ,CTVIN,KR | 

DIMENSION A(KR»1», VAL(l), VEC(KR,1» 

CALCULATE EIGENVALUES / EIGENVECTORS OF (AHVEC) = (VECM-VAL-I. 
JACOei MB ’"HOP, THRESHOLD VERSION. PROGRESS FROM PIVOT ELEMENT 
(IPIVOTt^r-IVOT) TO ELEMENT ( IPIVOT» JPI VCT^l I AFTER A PIVOT- 
THE lA) MATRIX SHOULD EE REAL, SYMMETRIC. UPPER HALF IS USED. 
DEVELOPED BY R L KOHLEN. AUGUST 1972. 

LAST REVISION BY R A PHILIPPUS. JUNE 1973. 

SUBROUTINE ARGUMENTS 

A = INPUT MATRIX TO BE DIAGONALIZED. SIZE(N,NI. ♦DESTROYED* 

VAL OUTPUT VECTOR OF EIGENVALUES. SIZE(N). 

VEC = OUTPUT MATRIX OF EIGENVECTORS. SIZE(N,NI. 

NIN = INPUT AES(NINI-N IS THE SIZE OF MATRICES A, VEC, VECTOR VAL. 

IF NIN IS NEGATIVE, INITIAL VEC MATRIX IS ASSUMED TO 
BE SUPPLIED FROM ARGUMENT- 

CTVIN = INPUT CONVERGENCE TOLERANCE ON EIGENVALUES. CONVERGENCE 
ASSUMED IF ABS( EIGENVALUE I LESS THAN CTVIN OR IF 
THE EIGENVALUE RATIO OF ( CURRENT-PRECEDING 1/CURRENT 
IS LESS THAN CTVIN. 

IF CTVIN .LE. O.t l0**-6 WILL BE USED. 

KP = INPUT ROW DIMENSION OF A, VEC IN CALLING PROGRAM. 

N = 1ABS(NIN| 

IF (NIN ,LT. Cl GO TO 10 
SET INITIAL VEC MATRIX TO UNITY. 

DO 6 I=I,N 
DO f J=1,N 

5 VECn.J) = c.c 

6 VEC(I,n = I.O 

10 IF (N .EQ. 11 GO TO 60 

SET INITIAL EIGENVALUES, CONVERGENCE TOLERANCE. 

DO 12 1 = 1, N 
12 VAl m = A(I,I 1 
CTVAL = CTVIN 

TF (CTVIN .LE. 0.1 CTVAL=l.E-6 
C FIND LARGEST OFF-DIAGONAL ELEMENT iTHRESHl OF A. 

THPESH = ABS(A(1,211 

NMl = N-1 

OP 15 1 = 1, NM 

IPl = I+l 

DO 15 J=IP1,N 

15 IF (ABS(A(I,J11 .GT. THRtSHl THRESH=A8S (A( I , J 1 1 
C 

C SCAN UPPER OFF-DIAGONAL ELEMENTS OF MATRIX A BY ROWS UNTIL A VAl UE 
C GREATER THAN THRESH IS FOUND. PIVOT ON THIS ELEMENT (IP,JP1. 

20 THRESH = THRESH/10. 

22 IREDO = 0 

DO Ai IPrl,NMl 
IPMl = IP-1 
IPPl = IP,^! 

DO AO JP=IPP1,N 
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IF (ABSCAdP.JPI) .LT. THRESH) GO TO 40 
IRFOr = 1 

C CALCULATE ROTATION VALUES- 

OEL = A(IP,IP| - A(JP,JP) 

RAO = SQRT <DEL*^2 ♦ 4,*A ( IP, JP)=A*2 ) 

IF (DEL .LT. 0.) RAP=-RAD 

TN = (2. A<IP,JP)) / lOEL ♦ RAD) 

CS = 1. / SORT U. ♦ TN**2) 

SF? = TN ♦ CS 

C DIAGONALIZE MATRIX (A). ONLY UPPER HALF IS USED. 

JPMl = JP-1 
JPPl = JP+1 

IF (IP .EC. 1 ) GO TO 33 
DO 32 I=1,IPM1 

AlIP = A(I,IP)»CS + A(I,JP)*SN 
A(I,JP) =-A(I,IP)*SN ♦ A(ItJP)*CS 

32 A (I, IP) = A I IP 

33 IF (IPPl .EO. JP) GO TO 35 
DO 34 I=IPP1,JPM1 

AIPI = A(IP,I)*CS + A(I,JP)*SN 
A(1,JP) =-A(IP,I)*SN ♦■A(I,JP)4CS 

34 A(IP,1) = AIPI 

35 IF (JP .EC. N) GO TO 37 
DC 36 I=JPPI,N 

AIPI = A(IP,I)*CS + A(JP,I)*SN 
A(JP,I) =-A(IP,I)^SN ♦ A(JP,I)=ACS 

36 A(IP,I) = AIPI 

37 AIPIP = A(1P,IP) 

AJPJP = A(JP,JP) 

CS2 = CS**2 

SN2 = SN**2 

ASC = 2.#A(1P,JP)*SN*CS 
A(IP,1P) = AIPIP-^CSZ ♦ ASC ♦ AJPJP*SN2 
A(JP,JP) = AIPIP4SN2 - ASC + AJPJP*CS2 
A(IP,JP) = O.C 
C CALCULATE f IGFMVECTORS . 

DO 38 1=1 ,N 

VECIIP = VEC(I,IP)*CS ♦ VEC( I,JP)=^SN 
VEC(I,JP) =-VEC( 1 ,IP)*SN ♦ VEC(I,JP)*CS 

38 VEC(I,1P) = VECIIP 

40 CONTINUE 

41 CONTINUE 

IF (IREDO .EC. 1) GO TO 22 
C TEST EIGENVALUES FOR CONVERGENCE. 

DO 52 1 = 1, N 

IF (ABS(A(1,D) .LT. CTVAL) GO TO 52 

IF (APS((A(I,I)-VAL(I))/A(I,D) .GT. CTVAL) GO TO 55 
52 CONTINUE 
GO TO 6C 

55 DC 56 1=1, N 

56 VAL(I) = A(I,I) 

GO TO 20 

C PLACE DIAGONAL FROM A INTO VAL ( EIGENVALUES ) . 

60 DO 61 1=1, N 
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C 


61 VAL(I) 
RETURM 

END 


A(i,n 
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SUBROUTINE FRl ( A,B, C,Ot T aBW ,TA8F, W,NX ,NW,NRTABF ,NCTABF, 

♦ KA,KF»WRK,NTAPF| 

DIMENSION A(KA,1 I ,E tKA, 1 1 ,C f K A, 11 ,D iKAf 1 1 *TAB W(KF ,1 1 , TABF (KF, 1 1 , 

♦ W(l) ,WRK(KA,1 J,F(80J,XRI5C) *XI (50J ,GN(50) ,GNDE(50), 

♦ PHAS(50I,KW(50) ,IV( 501 .IRE(50) ,BIN( 50),U(50) 

DATA NIT, NOT/5, 6/ 

DATA NLPP / 60 / 

C 

C FREQUENCY RESPONSE ROUTINE TO SOLVE THE DIFFERENTIAL EQUATION 
C (-w*m2*A + IW*B +CI*X(WI = D*F(W) FOR XCW). 

C MATRIX B MUST BE NON-SINGULAR. 

C VECTOR E IS OBTAINED BY LINEAR INTERPOLATION USING TABW, TABF. 

C THE ANSWERS (F, XREAL,XIMAG, GAIN, GAIN (DECIBELSI , PHASE ANGLE) WILL BE 
C WRITTEN ON PAPER AND NTAPE EVERY W (OMEGA). 

C CALLS FORMA SUBROUTINES INV1,MULT,MULTB,PAGEHD,Z2E0ME. 

C THE MAXIMUM SIZES ARE 
C NX =50 

C NRTABF = BO 

C COOED BY CARL BOOLE Y. AUGUST 19fc5. 

C LAST REVISION BY J ERNST, OCT 1973. 

C 

C SUBROUTINE ARGUMENTS (ALL INPUT) 

C A = MATRIX COEF OF -W*^2. SIZE (NX, NX I. *DESTROYED* 

C B = MATRIX COEF OF IW. SIZE (NX,NX). ♦DESTROYED* 

C C = MATRIX. SIZE (NX, NX). ♦DESTROYED* 

•C D = MATRIX COEF OF F. SIZE (NX, NRTABF). *DESTRCYEO* 

. TABW = TABLE OF OMEGAS FCR FORCE IN TABF, SIZE (NRTABF ,NCTABF ) . 

•c OMEGA IS IN RADIANS/SEC. 

C TABF = TABLE OF FORCES AT OMEGA IN TABW. SIZE (NRTABF ,NC TABF ) . 

C W = VECTOR OF F'^EOUENCIES AT WHICH EQUATION IS SOLVED. SIZE(NW). 

C OMEGA IS IN RADIANS/SEC. 

C NX = SIZE OF MATRICES A, B,C,WRK, .SQUARE) . NUMBER OF ROWS IN D. 

C MAX=50. 

C NW = SIZE OF VECTOR W. 

C NRTABF = NUMBER OF ROWS IN TABW, TABF. NUMBER OF COLS IN D. 

C MAX=CO. 

C NCTABF = NUMBER OF COLS IN TABW, TABF. 

C KA = ROW DIMENSION OF A,B,C,D,WRK IN CALLING PROGRAM. 

C KF = ROW DIMENSION OF TABW, TABF IN CALLING PROGRAM. 

C WPK = WORKSPACE MATRIX. SIZE (NX, NX) 

C NTAPE = NUMBER OF TAPE ON WHICH ANSWERS WILL BE WRITTEN, (E.G. A) 

C 

C the output data (TO BE WRITTEN ON PAPER AND NTAPE AT EACH OMEGA) IS 
C W = omega. SCALAR. RADIANS/SEC. 

C F = FORCE OBTAINED BY LINEAR INTERPOLATION ON TABF. 


C SIZE(NRTABF ). 


c 

XR 

= X (PEAL) . 

SIZE(NX). 

c 

XI 

= X(IMAG). 

SIZE(NX). 

c 

GN 

= GAi (SOPT( XR**2i-XI**2) ). 

SIZE(NX). 

c 

GNDB 

= GAIN(OECIBELS). 

S1ZE(NX ). 

c 

PHAS 

= PHASE ANGLE (DEGREES). 

SIZE(NX ). 


■ 2010 FORMAT (//lOX, 7HFREQ = F10.4,eH RPS, = ,F10.A,4H CPS) 

‘ 2015 FORMAT (//lOX ,49HR*A INVERSION CHECK. MAXIMUM DIAGONAL ERROR = 

♦ Ell. 3, 6H AT (,I3,1H, ,I3,1H), 
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♦ /31X, 28MMAXIMUM OFF-OIAGCNAL ERROR = 

♦ Eli. 3, 6H AT (,I3,1H,*I3»1H) ) 

2020 FORMAT ( //I OX , 14HAPPL lED FORCES / ClOX, 5E16.8)) 

2030 FORMAT (//10X,3HR0W,9X,7HX«PEAL) t 13X,7HXf IMAGI tl2X,9HAMP RATIO, 

♦ OX,14HAMP RATIO (OB »,6X,I!HPHASE (DEG), 

♦ //(10X,I3,AE20.e,5X,F11.6n 


NERROR=I 


C 


IF (NX.GT.50 -OR. NRTABF.GT.80) GO TO 999 


REWIND NTAPE 

WRITE (NTAPE) ( (A(I,J 1,I = 1,NX1,J=I,NX) 
REWIND NTAPE 

CALL INVl (B,A, NX, KAl 

CALL MULTB { A ,C ,NX ,NX,NX ,KA,KA I 

CALL M'JLTP ( A,D,NX,NX,NRTABF,KA,KA) 

DO 15 1=1, NX 
DO 15 J=1,NX 
15 B(I,J)=A( I,J) 

READ (NTAPE) ( ( A( I, J) ,1=1 ,NX) ,J=1,NXI 
CALL MULTB ( B,A,NX ,NX,NX ,KA,KA) 

REWIND NTAPE 


C 

C 


DO 500 L=1,NW 

CHECK OMEGA TAPLE (TABW) AND INTERPOLATE (LINEAR). 

DO 28 I=1,NRTABF 

NERRCR=2 

IF (W(L ).LT.TAPW(I,1) ) GO TO 999 
DO 22 J=2,NCTABF 

NERR0R=3 

IF (TABW(I,J-1 ).GE.TABW(I,J) -AND- W( LI -GT.TABW( I , J-1 Jl GO TO 999 
IF (W(L) ,LT. TABWd.J)) GO TC 28 
22 CONTINUE 

NERR0R=4 


A=A 

A=BI 

C=BIC 

0=BID 


B=BI 

A=A 

A=BIA 


C 


GO TO 

28 F(l) = TABF(I,J-1) ♦ (W (L )-TABW( I , J-1 ) I ♦ ( TABF( I ,J )-TABF ( I ,J-1 ) )/ 
1 (TABW(I,J)-TABW(I,J-1) ) 


CALL MULT ( D ,F ,XI ,NX,NRTAEF ,1 ,KA,KF ) XI=BIDF 

DO 30 1=1, NX 
DO 30 J=I,NX 

B(I,J) = C(I,J) - (W(L)=A*2I*A(I,JI B=C-A»W2 

30 WRK(I,J)=B(I,J) WRK=P 

CALL MULT ( B , XI ,XR ,NX ,NX, 1, KA,KA ) XR=B*XI 

DO 40 1 = 1, NX XI=-W* 

40 Xim = -W(L)*XI(I) EIDF 

CALL MULTB ( WRK,B,NX ,NX,NX,KArKA) B=B**2 

DO 50 1 = 1, NX 

50 6(1,1) = B(I,1) ♦ W(L)**2 B=B+W2 


BEGIN INVERSION (STATEMENTS FROM INV2). 

NEKR0R=5 

IF (NX ,Et'. 1 .AND, B(l,l) ,E(J. 0.0) GO TO 999 
IF (NX .EC. 1 .AND. b(l,l) .NE. 0.01 GO TO 153 
IT = 1 
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GO TO 60 
55 IT = 2 
60 DO 65 1=1, NX 
IREfl) = 1 
65 IVfl) = I 
NMl = NX - 1 
DO 75 L2=1,NM1 
SMAX = 0.0 
DO 70 J=L2,NX 
LA = IRE(J) 

I = L2 
K = LA 

IF (IT .FC. 2) I = LA 

IF (IT .EC. 2) K = L2 

IF (ABS(3(K,D) .Lt. SMAX) GO TO 70 
JMAX = J 

SMAX = ABS(B(K,D) 

70 CONTINUE 

LS = IPE(L2I 
IRE(L2) = IREfJMAX) 

75 IRE(JMA ) = LS 
DO 80 L2=1,NX 
LA = IRF(L2' 

BIN(L2) = P(LA,L2) 

IF (IT .EO. 2) BIN(L2) = B(L2,LA) 

80 IF (BIN(L2) .EQ. 0.0) BIN(L2) = l.O 
DO 90 L2=1,NX 
LA = IRE(L2) 

I = L2 
K = LA 

IF (IT .EQ. 2) I = LA 
IF (IT .EO. 2) K = L2 
DO 85 J=1,NX 
M = J 
Ml = LA 

IF (IT .EC. 2 ) M = LA 
IF (It .EC. 2) Ml = J 
85 WRK(M,M1 ) = 0.0 

WRK(I,K) = 1.0/BINIL2) 

90 B(K,I) = B(K,I) ~ BIN(L2) 

DO 120 L2=1,NX 
SMAX = 0.0 
DC 100 J=L2,NX 
LA = rv(j) 

S = 1.0 
DO 95 K=1,NX 

95 S = S ♦ B(LA,K)*WPK(K,LA) 

IF (ABS(S) .LE. SMAX) GO TO 100 
LMAX = J 
SMAX = ABS(S) 

100 CONTINUE 

IF (SMAX .GT. 1.0E-V9) GO TO 105 

N’:RR0R=6 

IF (IT .EC. 2) GO TO 999 
GO TO 125 



105 LS = IV(L2) 

IVCL?) = IV(LMAX) 

IV(LMAX) = LS 
LA = IV(L?I 
DC 110 I=1,NX 
WW(I) = 0.0 
DO 110 J=ltNX 

110 ww(i) = wwm ♦ e(LA,ji^wRK(j,n 

S = 1.0 + KW(LAI 
DO 115 1=1, NX 

115 U(II = WRK<I,LA) 

DO 120 1=1, NX 
DO 120 J=1,NX 

120 WRK(I,J) = WRKd.J) - U(I)»WW(J1/S 

125 DO 130 L2=1,NX 
LA = IRE(L2) 

I = L2 
K = LA 

IF (IT .EO. 2) I = LA 
IF (IT .EQ. 2 ) K = L2 

130 B(K,!) = B(K,n - BIN(L2l 

IF (SMAX .LE. l.OE-99) GO TO 55 

DIAGER = 0. 

lOIAG = 1 

XOFF = 0.0 

lOFF = 1 

JOFF = 1 

DO 150 J=1,NX 

DC 145 1=1, NX 

X = 0.0 

DO 135 K=1,NX 

135 X = X ♦ WRK(I,K)*F(K,J) 

IF (I .NE. J) GO TO 140 
IF (APS(X-1.) .LT. DIAGERl 60 TO 145 
DIAGER = ABS(X-1.) 

IDIAG = I 
GO TO 145 

140 IF (ABS(X) .LT. ABS(XOFF)) GO TO 145 
XOFF = X 
lOFF = I 
JOFF = J 

145 CONTINUE 

150 CONTINUE 
GO TO 155 

153 WRK(1,1) = 1.0/B(1,1) 

DIAGER = B(1,1)*WRK(1,1) - 1. 

IDIAG = 1 
XOFF = 0. 

ItrF = 0 
JOFF = 0 

155 CALL MULTP ( WRK ,XP ,NX ,NX , 1 ,K A,KA ) XP=XREAL 

CALL MULT6 ( WRK , XI ,NX,NX ,1 ,K A,KA ) XI=XIMAG 

C GET GAIN, PHASE ANGLE. 

DO 180 1=1, NX 
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GN(I) = SCPHXR(n»»2 + Xim=k*2l 
GNDB(I) =0.0 

IF (GNtl) .GT. 0.0) GNDB( I)=20.0*ALCG10(GNf in 
PHAS(I) =0.0 

180 IF (Xl(I) .NE. 0.0 .OR. XRII) .NE. 0.0) PHAS(I)= 

1 57.29578*ATAN2(XIU) ,XRC1) ) 

PRINT ANSWERS ON PAPER. HEAD A NEW PAGE EACH OMEGA- 
CALL PAGEHD 
FREQ= W(L )/6. 283185 
WRITE <NCT,201C) W(L), FREC 

WRITE (N'CT,2015) DI AGER ,IDI AG , IDI AG ,XC!FF * lOFF , JOFF 
WRITE (NOT, 2020) (F (I ) , 1= 1 ,NRTABF ) 

NXS = 1 
NXE = NX 

NFLN = (NRTABF~l)/5 + 1 

IF ((NXE ♦ NFLN) ,GT. (NLPP-19)) NXF= (N LPP-19 )-NF LN 
190 WRITE (NOT, 2030) ( I ,XR ( 1 ) ,X I ( I ) ,GN ( I ) ,GNDB( I ) ,PHAS( 1 ) ,I=NXS ,NXE ) 

IF (NX -FC. NXE) GO TO 200 
NXS = NXE + 1 
NXE = NX 

IF ((NXE-NXS) .GT. (NLPP- 9)) NXE=NXS-^( NLPP- 9) 

CALL PAGEHD 
GO TO IPO 

WRITE ANSWERS CN NTAPE FOR SUBSEOUENT USE (SUCH AS 
FREQUENCY RESPONSE ADDITIONAL EQUATIONS OR PLOI). 

200 WRITE (NTAPE) W( L ) , (F ( J ) , J=1 , NRTABF ) 

WRITE (NTAPE) ( XR ( I ) , XI ( I ) ,GN ( I ) ,GNDB ( I ) ,PHAS ( I ) , 1=1 , NX ) 

500 CONTINUE 
RETURN 

999 CALL 2ZB0MB (6HFR1 ,NERROR) 

END 
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SUBROUTINE FRAEl ( A, STA, ZI OENT*NZ »NX ,NW,KA .NXTAPE *NZTAPE ) 
DIMENSION A(KAtl) tSTA(l)tXR(50),X'i I5G)»ZR(80)«ZI(e0),GN(80}» 

* GNDP(80),PHAS(80»,ZIDENT(I2» 

DATA NIT,NCT/5»6/ 

DATA NLPP /SO / 

C 

C FREQUENCY RESPONSE ADDITIONAL EQUATIONS ROUTINE. 

C SOLVE THE COMPLEX MATRIX EQUATION ZIW) = A*X(W). 

C W=OMEGA, X«W):^tXREAL»XIMAG) IS OBTAINED FROM NXTAPE COUTPUT OF 
C FREQUENCY RESPONSE SUBROUTINE). 

C THE ANSWERS ( W ,ZRE AL »Z IM AG *GAIN,GAIN (DEC IBELS ) »PHASE ANGLE) WILL BE 
C WRITTEN ON PAPER AND NZTAPE EVERY W=OMEGA OF FREQ RESP SUBRT. 

C CALLS FOPMA SUBROUTINES PAGEHD ,ZZBOMB. 

C THE MAXIMUM SIZES ARE 

C NZ = 80 
C NX = 50 

C CODED BY RL WOHLEN. AUGUST 1965- 
C 

C SUBROUTINE ARGUMENTS (ALL INPUT) 

C A = MATRIX COEF OF X(W). SIZEfNZtNX) 

C STm = VECTOR OF STATIONS. SIZE(NZ). ( A6 FORMAT). 

C ZIDENT = HEADING FOR Z IN OUTPUT DATA- (UP TO 12A6 FORMAT). 

C NZ = NUMBER OF ROWS OF MATRIX A. MAX=80. 

C NX = NUMBER OF COLS OF MATRIX A. MAX=50. 

C NW = NUMBER OF OMEGAS TO BE READ FROM NXTAPE- 

C KA = ROW DIMENSION OF A IN CALLING PROGRAM. 

NXTAPE = NUMBER OF TAPE FROM WHICH W.X WILL BE READ. (E.G. 3). 

C NZTAPE = NUMEEP OF TAPE ON WHICH W, ZR , ZI »GN, GNDB ,PHAS 
C WILL BE WRITTEN (EG A). IF NZTAPE=0 BYPASS WRITING ON NZTAPE 

C 

C THE OUTPUT DATA (TO BE WRITTEN ON PAPER AND NZTAPE EACH OMEGA) IS 


C 

w 

= OMEGA, SCALAR. RADIANS/SEC. 

c 

ZR 

= Z (REAL) . 

SIZF(NZ ). 

c 

ZI 

= 2 (IMAG) . 

SI2E(NZ ). 

c 

GN 

= GAIN (SQRT(ZR**2+2I*#2) ). 

S1ZF(NZ ) - 

c 

GNDB 

= GAIN(DECIBELS). 

SIZE(NZ). 

c 

PHAS 

= PHASE ANGLE (DEGREES). 

SI2E(N2). 


C 

2010 FORMAT (/15X, 12A6, //lOX, 7HFPEQ - F10.A,8H RPSt = F10.A,AH CPS) 
2030 FORMAT ( //lOX ,3HR0W ,3 X, 7HSTATI0N ,9X »7HZ (P EAL ) , 13X ,7HZ ( IMA6 ) , 

♦ 12X»9HAMP RATI0»9X, lAHAMP RATIO ( DB ) ,6X ,1 IHPHASE (DEG), 

♦ //( 10X,I3,AX,A6 ,AE20-8,5X,F11.6)) 


IE (NX .GT. 50 .OR. NZ .GT. EO) GO TO 999 
REWIND NXTAPE 

IE (NZTAPE .GT. 0) REWIND NZTAPE 

C 

DO 100 IOMEGA = 1 ,NW 
READ (NXTAPE) W 

READ (NXTAPE) { XR ( I ) ,XI ( I ) ,DUM,DUM,OUM, I=1,NX) 

DC 10 1=1, NZ 

ZR(I) = O.C 

ZKI) = 0.0 

DO 10 J=1,NX 
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, ZR(1I = ZPm + A(I,JI ♦ XP(J) 

' 10 ZKII = ZKII + A(I,JI ♦ XKJ) 

C 

C GET GAIN, PHASE ANGLE. 

DO 55 I=1,NZ 

GNdl = SC!RT(2R(n>^*2 ♦ ZICn*^2l 
GNDBm =0.0 

IF (GN<I) .GT. 0.01 GNDBC II=20.0*AL0G10(GN( I) I 
PHAS(I) = 0.0 

55 IF (ZKII .NE. 0.0 .OR. ZR(I) .NE. 0.0) PHAS<I) = 

1 57.29578*ATAN2<ZI{l),2RCin 

C 

C PRINT ANSWERS ON PAPER. HEAD A NEW PAGE EACH OMEGA. 

CALL PAGEHD 
FREO= W/6.2R3165 

WRITE (NOT, 2010) 2IDENT, W, FREQ 
NZS = 1 
NZE = NZ 

IF (NZE .GT. (NLPP-13)) NZE=NLPF-13 
60 WRITE (NGT,2030) ( I ,S TA ( I ) , ZR ( I ) ,21 ( I ) ,GN (I ) ,GNOB ( I ) ,PHAS ( I I , 

♦ I=NZS,NZE) 

IF ;NZ .EO, NZE) GO TO 80 
NZS = NZE + 1 

NZE = NZ 

IF ((NZE-NZS) .GT. (NLPP-10)) NZE=NZS-( NLPP-IO ) 

CALL PAGEHD 
[ GO TO 60 

c 

C WRITE ANSWERS ON NZTAPE FOR SUBSEQUENT USE (SUCH AS PLOTTING). 

80 IF (NZTAPE .GT. 0) WRITE (NZTAPE) W , C STA( I ) ,ZR ( I ) ,2 ! ( I ) ,GN( I ) , 

♦ GNDB(I),PHAS(I), 1=1, NZ) 

C 

100 CONTINUE 
RETURN 
C 

999 CALL ZZBOMB (6HFPAE1 ,NERROR) 

END 
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SUBROUTINE IN (NTAPE,Z,N) 

DIMENSION Zdl 

READ DATA FROM NTAPE INTO CORE SPACE Z. 

CODED BY RL WOHLEN. MARCH 1976. 

SUBROUTINE ARGUMENTS 

NTAPE = INPUT NUMBER OF TAPE. (EG 10). 

2 = OUTPUT DATA READ FROM TAPE. 

N = INPUT NUMBER OF WORDS OF DATA TO BE READ FROM NTAPE. 

READ (NTAPE) (Z(I),I=ltN) 

RETURN 

END 
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SUBROUTINE INTAPE ( NTAPE ,TAPE ID) 

COMMON /LLINE/ NL INE , MAXL IN .MINI 
DATA IZl,BUr,E0T/l,0.f3HEOT/ 

DATA NITtNOT/5,6/ 

INITIALIZE TAPE FOR SUBROUTINE WTAPE. 

CALLS FORMA SUBROUTINE PAGEHO. 

CODED BY RF HRUDA. JULY 1968. 

LAST REVISION BY RL WOHLEN. APRIL 1976. 

SUBROUTINE ARGUMENTS (ALL INPUT) 

NTAPE - NUMBER OF TAPE. (E.G. 10). 

TAPEID = TAPE IDENTIFICATION. (E.G. T1239). (A6 FORMAT). 

2001 FORMAT (//// lAH LOGICAL UNIT 12. 7H. TAPE A6 . 

♦ 23H. HAS BEEN IN ITI ALI 2FD. ) 

2050 FORMAT (/ IX 123(lh-) ) 

C 

REWIND NTAPE 

WRITE (NTAPE) TAPEID. IZl . EOT. (BUF . I =1 .16 J 
ENDFILE NTAPE 
REWIND NTAPE 

IF (MINI .NE. AFMINI) GO TO 800 

IF (NLINE .LE. 5 .OR. NLINE .GE. MAXLIN) GO TO 800 
IF ((NLINF+2+5 ) .GT. MAXLIN) GO TO 800 

WRITE (NOT, 2050) 

Nl INE = NLINE + 2 
GO TO 810 
800 CALL PAGENJ 

810 WRITE (NOT, 2001) NTAPE, TAPEID 
NLINE = NLINE ♦ 5 

C 

RETURN 

END 


/ 


I 



r> n ^ n r>< 




1/ 3 


SUPRCUTI''}F INVl (A,2,N,KR| 

DIMFNSION A(l), ZCl) 

COMMON /LWPKVl/ G(?PO), DETR(250) 

COMMON /LWPKV2/ IX(250), Bf250) 

COMMON /LLINF/ NL 1NE,MAXLIN»MIN1 
DATA NIT, NOT/5,6/ 

C 

C MATRIX INVERSION (A**-l = ZI. BCROERING METHOD. 

C THE DETERMINANT PATIO OET<I + I) / DETIl) IS PRINTED. OETd) IS THE 
C DETERMINANT CE THE ^IRST I BY I SUB-MATRIX OF A. 

C THE INVERSION CHECK Z*A IS CALCULATED AND PRINTED. 

C MATRICES A,Z MAY SHARE SAME CORE LOCATIONS. (Z»A CHECK IS INVALID). 
C CALLS FORMA SUBROUTINES PAGE HD ,Z ZBOMB . 

C THE MAXIMUM SIZE IS 
C N = 250 

C DEVELOPED BY BOB DILLON. FEBRUARY IR'GS. 

C LAST REVISION BY RL WOHLEN. MAPXH 1976. 

C 

C SUBROUTINE ARGUMENTS 

A = INPUT MATRIX TO BE INVERTED. SI2E(N,N). 

Z = OUTPUT RESULT E.ATPIX. S1ZE(N,N). 

N = INPUT SIZE OF MATRICES A, 2. MAX=250. 

KR = INPUT ROW DIMENSION OF A, 2 IN 'ALLING PROGRAM. 


i ? 


NER;OR EXPLANATION 

1 = SIZE GREATER THAN 250. 

2 = FIRST COLUMN IS ZERO. 

3 = MATRIX IS SINGULAR. 


2000 FORMAT 

2001 FORMAT 
* 

♦ 

2002 FORMAT 

♦ 

2003 FORMAT 
♦ 

2050 FORMAT 


HAS CALCULATED THE DATA BELOW 
RATIOS OETd + U / DETIl) ARE 


«// 1CX,10<7X,1HC,I2,1H))) 

(// 10X,45HSUBR0UTINE INV'l 
///10X,44HTHE DETERMINANT 
// n3X,10Fil .3) ) 

(///10X,37HTHE (A44-1)>MA) INVERSION CHECK GIVES 
///10X,25HTHE DIAGONAL ELEMENTS ARE // (13X,I0E11 .6) ) 
(// 10X,35HTHE MAXIMUM OFF-DIAGONAL ELEMENT IS 
Ell. 3, 2X, 4HAT < 13, IH, 13, IH) ) 

(/ IX 123(1H-) ) 


NERRCR=1 


IF (N .GT. 250) GO TO 999 


DO 160 1=2, N 
160 IX(I) = 1 

C INVERT FIRST NL’N-ZERC ELEMENT IN FIRST COLUMN. 

00 190 1 = 1, N 

IF (mII) .NE. 0.) GO TO 220 
190 CCNTl’^UE 

NERR0R=2 


GO TO 999 


START INVERSION WITH ROW I. 
220 DE-'RU) = MI) 

Z:i) = 1. / Ad) 

IF (N .EO. 1) RETURN 
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IXIIJ ^ 1 
IXH) = 1 

C BORDFRING LCCR. 

DO 630 L-2»N 
K = L 

LI = L - I 
250 5 ^ O. 

MIXL = KR ♦ IIXIU - Ti 
LL = XX (L) ♦ MIXL 

DO 450 I=1,L1 

MJXI = KR * (iX(I) - 1) 

LI = IX(L) ♦ MIXI 

B(I) = 0. 

G(I) = G. 

DC 440 J=1»L1 

MIXJ = KF ♦ (JX(J} - 1) 

IJ = IX(I) + MIXJ 
jL = IX (J) ♦ MIXL 
6(1) - B(I) - Z(IJ)*^ A' • > 

JI = IX ( MIXI 

LJ = IX tL . -I- KIXJ 
440 G(I) = G(I) - A(LJ)» 2(JI> 

450 S = S + A (LI)* 6(1) 

AL = a(ll;+ S 

IF (AILL) .fC. 0.) ro 1C 460 
ALBAR = ABS (AL / AiLL) ) 

GO TO 460 

480 ALBAR = ABS ( Al ) 

490 IF (ALEAR .GF. .lE-6) GO TO 550 

C 

C INTERCHANGE ROWE AND COLUMNS. 

K = K ♦ 1 

IF (K .GT , N) GO TO 540 
IX L - IX <L) 

1X(L) IX(K) 

IX(K) = rx L 

GO TO 250 

540 IF (ALBAR .GE. .lE-8) GO TO 550 

NFRR0R=3 

GO TC V94 

550 2(LL)= 1. / AL 
OrTR(L) = AL 
DC 570 1=1, LI 

IL = IX(I) 4 MIXL 
LI = IX(L) 4 KR * (iXtl) - 1) 

Z(IL)= R(l) ♦ Z(LL) 

Z(LI)= G(I) * 2(LL*. 

DO 570 J= 1,1.1 

= ;x(l) 4 KR * (IX(J) - 1 ) 

*•70 Z(IJ)= 2(1J)4 G(J1 * 2(IL) 

630 OONTINUF 

( CNPUTE INVERSION CHECK 2 'A. 
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XCFF = 0.0 
00 720 1=1, N 
DC 710 J=l,N 
X = 0.0 

KJA = KP * (J-II 
or 703 K=1,N 
IK = I ♦ KR*(K-1 } 

KJ = K ♦ KJA 

703 X - X + Z(IK> * A(KJ) 

IF (I .NE. Jl 0 TO 705 
G(n = X 
GO TO 7!0 

705 IF lARSfXI .LT. ABS(XCFF)i 30 TO 710 
XO*^F = X 
lOFF = I 
JOFF = J 
710 CONTINUE 
720 CONTINUE 

PRINT THE DETERMINANT RATIO AND INVERSION CHECK. 

NPL = N/10 

IF f|NPL»10» .NE. N) NPL = NPL+1 

NNL = 2-NPL + 21 

IF (MINI .NE. AHMINII GO TO 800 

IF (NLINE .LE. 5 .OP. NLINF .GE. MAXLIN) GO TO 800 
IF ((NLINE+2+NNLI .GT. MAXLINI GO TO 800 
WRITE (NOT, 2050) 

MINE = NLINE + 2 
GC TO 8iO 
800 CALL PAGE HD 

810 WRITF (NOT, 2000) (JC, JC=1,10) 

WRITE (NOT, 2001) (OETR(I), I=1,N| 

WRITE (NOT, 2002) ( G (I), I=1,N| 

WRITF (NOT, 2003) XOFF ,IOFF» JOFF 

NLINE = NLINE ♦ NNL 

RETURN 


* 


C 


999 CALL ZIBO.-. (6HINV1 ,NERROR) 
END 
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SUBRPUTINE INV2 (A*Z,N,KR) 

DIMENSION A(KR,1), Z(KP.,1|, W(?50» 

COMMON /LWRKVl/ IRE (250), BIN(250) 

COMMON /LWPKV2/ 0(250), IV(250) 

COMMON /LLINE/ NL INF, MAXLIN, MINI 
DOUBLE PRECISION DM ,DS , ZERO ,ONE 
DATA ZERO/O.D/, CNE/l.D/ 

DATA NIT, NOT/5, 6/ 

MATRIX INVEPriON - 1 ), RANK ANNIHILATION METHOD. 

ALGORITHM FORMULATED EY C/'vL BCD LEY. 

THE INVERSION CHECK Z»A IS CALCULATED AND PRINTED. 

INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

CALLS forma subroutines PAGEHD ,2ZB0MB . 

THE MAXIMUM SIZE IS 
N = 250 

DEVELOPED BY CARL BODLEY. JANUARY 1967. 

LAST REVISION BY RL WOHLEN. MARCH 1976. 

SUBROUTINE ARGUMENTS 

A = INPUT MATRIX TO PE INVERTED. SIZE<N,N). 

Z = OUTPUT R*^SULT MATRIX- SIZF(N,N). 

N = INPUT SIZE OF MATRICES A ,Z . MAX=?50. 

KR = INPUT ROW DIMENSION OF A,Z IN CALLING PROGRAM. 

NERPOR EXPLANATION 
1 = SIZE GREATER THAN 250. 

? = MATRIX IS SINGULAR. SIZE =1. 

3 = MATRIX IS SINGULAR. 

2000 FORMAT (// lOX , 10 (7X, IH ( , 12 , IH) ) ) 

2001 FORMAT (// 10X,A5HSUBRCUT1NF INV2 HAS CALCULATED THE DATA BELOW ) 

2002 FORMAT ( ///lOX ,37HTHE (A=>*-1)^(A) INVFRSION CHECK GIVES 

* ///1CX,25HTHE DIAGONAL ELEMENTS ARE // ( 1 3X , lOFll . 8 ) ) 

2003 FORMAT (// 10X,35HTHE MAXIMUM OFF-DIAGONAL ELEMENT IS 


♦ 



Fll .3, 

2v, 

4HAT ( 

13, 

IH, 13, IH) 

) 

2050 FORMAT (/ 

IX 

123(1H-) ) 














NERP0R=1 

IF 

(N .GT 

. ?5 

0) GO TO 999 





NERR0R=2 

IF 

(N .EQ 

. 1 

.AND. A(l,l) 

,E0 

. 0.0) 

GO 

T' 999 


IF 

(N .EQ 

. 1 

.AND. A(l,l) 

.ME 

. 0.0) 

GO 

TO 98 



GENERATE INITIAL ROW IN' ICES. 

IT = 1 
GO TO 90 
91 IT = 2 
90 DO 5 I=1,N 
IRP(l) = I 
5 IV(I) = 1 

CONDITION A FOR MAXIMUM DIAGONAL ELEMENTS. 
NMl = N - 1 
CO 6 L=1,NM1 
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SMAX = 0.0 
DO 8 J=l»N 
LA = IRE(J) 

I = L 
K = LA 

IF JIT .FC. 2) I = LA 

IF (IT .EC. 2) K = L 

IF (AF8(A(K»in .LF. SMAX) GO TO 8 
JMAX = J 

SMAX = ABS(A(KtI) ) 

8 CONTIlVUE 
LS = IRF(L) 

IRF(L) = IPE(JMAX) 

6 IRF(JMAX) = LS 
DC 7 L=ltM 

LA = IREU) 

PIN(L) = A(LA»L) 

IF (IT .FO. 2) PIN(L) = A(L,LA) 

7 IF (BIN(L) .EC. 0.0) BIK'(L) = l.C 

C 

C GENERATE INITIAL 2 AND ABAR. 

DC 10 L = 1 ,N 
LA = IPF(L) 

I = L 
K = LA 

IF (IT .EC. 2 ) I = LA 

IF (IT .EC. 2) K = L 

DO 15 J=1,N 
M = J 
Ml = LA 

IF (IT ,FC. 2) M = LA 
IF (IT .EC. 2) Ml = J 
15 Z (M,M1 ) = 0.0 

Z(1,K) 1.0/B1N(L) 

10 A(K,I) = A(K,1) - 8IN(L) 

C 

C INVERSION LOOP, USES ROW OF ABAR WITH MAXIMUM S. 

DP 35 L = l ,N 
SMAX = C.O 
DO 23 J =L,N 
LA - IV(J) 

DS = ONF 

DP 26 K-1 ,N 

DM = A(LA»K )*Z(K,LA) 

26 DS = DS + DM 
S = DS 

IF (APS(S) .LE. SMAX) GO TP 23 
LMAX = J 
SMAX = ABS(S) 

23 CONTINUE 

IF (SMAX .Gl. 1.0E-D9) GO TO 60 

NERRDR-3 

IF (IT ,EC. 2) GO TO 999 
GO TO 65 
60 LS = IV(L) 
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IViLl = fVILMAXI 
IV(LMAX) = LS 
LA = IV(L) 

DO 25 1 = 1 ,N 

DS = ZERO 

DO 2A J=1,N 

DM = A(LA,J)’^2<J,11 

24 DS = DS ♦ DM 

25 wm = DS 

S = 1.0 + W(LAI 
DD 30 1=1, \ 

30 U( I) = Z( I,LA) 

00 55 1=1 ,N‘ 

DO 35 J = 1,N 

35 Z<I,J) = ZCl.Jl - U(11*W(J|/S 

RESTORE A. 

65 DO ^0 L=1,N 
LA = 1RE(LJ 

1 = L 
K = LA 

IF (IT .EQ. 2) 1 = LA 

IF (IT -EO. 2) K = L 

40 A(K,I) = A(K,I) ♦ 6IN(L» 

IF (SMAX .LE. l.OE-991 GO TO 91 

COMPUTE INVERSION CHECK Z»*. 

XOFF = C.O 

DO 50 J=1,N 

DO 45 1=1 ,N 

DS = ZERO 

DO 46 K=1 ,N 

DM = Z( I,K)=!=A(K,J1 

46 OS = DS + DM 
X = DS 

IF (I .NE. J) GO TO 47 
U(I) = X 
CO TO 45 

47 IF(AeS(Xl .LT. XCFF 1 GO TO 45 
XCFF = X 

lOFF = I 
JHFF = J 
45 CONTINUF 
50 CONflNUE 

PRINT INVERSION CHECK AND MAXIMUM OFF-Di AGONAL ELEMENT. 
NPL = N/IC 

IF ((NPLTIO) ,NE. N) NPL = NPL-H 
NNL = WPL ♦ 17 

IF (MINI .NE. 4HMIN1) GO TO 80C 

IF (NLINF .Lr. 5 .OF. NLINE .GE. MAXL1F4I GO TO 800 
IF ( (NLINF42+NNL ) ,GT. MAXLIN) GO TO 800 
WRITF (NC7,?05C) 

NLINE = NtINL + 2 
GO TO 810 



800 CALL PAGEHD 

810 WRITE (NOT,2000) (JC, JC=1,10) 
WRITE (NOT, 2001 1 
WRITE (NCT.200?) ( U III, 

WRITE (NrT,2003> XOFF ♦lOFF, JOFF 

NLINE = NLINE + NNL 

RETURN 

98 Ztltl) = 1.0/A(1,1) 

RETURN 

999 CALL ZZBOKB (6HINV2 ,NERROP) 
END 
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SUBRCIITINF INV3 (AsZ,N,KR) 

DIMENSITN A(KR,1), Z(KR,1), WK250) 

COMMON /LWPKVl/ W?(250), DETR1250) 

COMMON /LLINF/ NLINF, MAXL IN,MINI 
DOUBLF PRECISION DM, DS, ZERO 

data zero /O.D/ 

DATA NIT,NOT/5,6/ 

C 

C MATRIX INVERSION (A>^*-I = Z) . METHOD USES TRIANGULAR DECOMPOSITION 
C AND TRIANGULAR INVERSION. MATRIX A SHOULD BE SYMMETRIC, POSITIVE 
C DEFINITE. UPPER HALF OF MATRIX A IS USED TO CALCULATE Z. FULL 
C MATRICES A,Z ARE USED FOR INVERSION CHECK. 

C THE DETERMINANT RATIO DETtI+1) / DETCI) IS PRINTED. DET(I) IS THE 
C DETERMINANT OF THE FIRST I BY I SUB-MATRIX OF A. 

C THE INVERSION CHECK Z*A IS CALCULATED AND PRINTED. 

C MATRICES A,Z MAY SHARE SAME CORE LOCATIONS. (Z»A CHECK IS INVALID). 
C INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION.. 

C CALLS FORMA SUBROUTINES DCOMl, INV4,PA6EHD, ZZBCMB . 

C THE MAXIMUM SIZE IS 
C N = 250 

C DEVELOPED CARL BODLEY. MARCH 1969. 

C LAST REVIS JN BY RL WOHLEN. MARCH 1976. 

C 

C SUBROUTINE ARGUMENTS 

C A = INPUT MATRIX TO FE INVERTED. SIZEfN.N). 

-C Z = OUTPUT RESULT MATRIX. S1ZE(N,N). 

i N = INP"~ SIZE OF MATRICES A,Z. MAX=?EO. 

KR = INPUT ROW DIMENSION OF A,Z IN CALLING »>RCGRAM. 


NERRCR EXPLANATION 
1 = SIZE GREATER THAN 250. 


2000 FORMAT 

2001 FORMA I 

♦ 

2002 FORMAT 

♦ 

2003 FORMAT 

* 

2050 FORMAT 
C 


(// 10X,10(7X,1HUI2,1H) ) ) 

(// 10X,45HSUBR0UTINE 1NV3 HAS CALCULATED THE DATA BELOW 
///10X,44HTHE DETERMINANT RATIOS DETd+i) / DET(l) ARE 
// (13X,10E11 .3) ) 

{///10X,37HTHE {A**-1)*(A) INVERSION CHECK GIVES 
///10X,?5HTHE DIAGONAL ELEMENTS ARE // IISX.IGFII.B)) 
(// 1CX,35HTHE MAXIMUM OFF-DlAGONAL ELEMENT IS 
Ell. 3, 2X, 4HAT ( 13, IH, 13, IH) ) 

(/ IX 123(1H-) , 


NERR0R=1 


IF (N .GT. 25Ci GO TO 999 


CALL OCOMDM (A,2,N,KR) 
DC 5 1=1, N 

5 DETR(I) = Z(1,I)*Z(I,1) 
CALL INV4DM (Z,Z,N,-KR) 
DO 40 L = 1 ,N 
Dn 20 I=L,N 
W1 (I ) = Z(L ,I ) 

DC 35 I = I ,N 
OS = ZERO 
DO 30 K = f ,N 


20 



no no 


INV3 


DM = Z( I,K)*W1(K) 

30 DS = ns ■*- DM 
35 W2(I) = DS 
JO 40 K = 1,N' 

40 Z(K,I.) = W2(K) 

CALCULATE INVERSION CHECK Z*A. 

XOFF = C.O 

DO 120 l=ltN 

DO no J=1,N 

DS = ZERO 

DO 105 K=1,N 

DM = Z(I,K)*A(K,J) 

105 DS = DS + DM 
X = DS 

IF (I .NE. J) GO TO 108 
WKI) = X 
GO TO no 

108 IF (ABS(X) .LT. ABSIXOFFM GO TO 110 
XOFF = X 
lOFF = I 

JC'F = J 

110 CCMTINUF 
120 CONTINUE 

PRINT THE determinant RATIOS AND INVERSION CHECK, 

NPL = N/10 

IF ((NPL»10) .NE, N> NPL = NPL+1 
NNL = 2*NPL ♦ 21 

IF (MINI .NE. 4HMINI) GO TO 800 

IF (NLIME .LE. 5 .OR. NLINE .GE. MAXLIN) GO TO 800 
IF ( (NL INE+2+NNL ) .GT. MAXLIN) GO TO 800 
WRITE (NOT, 2050) 

NLINE = NLINE + 2 
GO TO 010 
800 CALL PAGEHD 

810 WRITE |NOT,200C) (JC, JC=1,10) 

WFITE (NOT, 2001 ) (DETR(I), 1=1, N) 

WRITE (NOT, 2002) (Wl (I>, != J ,N) 

WRITE (NOT, 003) XOFF , It f v jQpc 

NLINE = NLINE + NNL 

RETURN 

999 CALL ZZPOMP (6HINV3 ,NERROP) 

END 
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SUBROUTINE INVA (A,Z,N,KR) 

DIMENSION A(KP,1I, Z(KR,1) 

DOUBLE PRECISION DMtDS 
DATA EPS/I. F-35/ 

C 

C MATRIX INVERSION = Z). MATRIX A IS ASSUMED TO BE 

C UPPER TRIANGULAR. 

C Mi.TRICES A,Z MAY SHARE SAME CORE LOCATIONS. 

C INNER PRODUCT SUMS APE PERFORMED IN DOUBLE PRECISION. 

C CALLS FORMA SUBROUTINE ZZBOMB. 

C COOED BY PL WCHLEN. JANUARY 1971. 

C LAST REVISION BY RL WOHLEN. MARCH 1976. 

C 

C SUBROUTINE ARGUMENTS 

C A = INPUT MATRIX TO BE INVERTED. SIZE(N,N). 

C Z = OUTPUT RESULT MATRIX. SIZE(N»N1. 

C N = INPUT SIZE OF MATRICES AtZ. 

C KR = INPUT ROW DIMENSION OF A,Z IN CALLING PROGRAM. 

C 

NERRCR EXPLANATION 

1 = A DIAGONAL ELEMENT IS LESS THAN l.F-35. 

NERROR = 1 

DO 10 1=1, N 

IF (ABSlAlItin .LT. EPS) GO TO 999 
10 ZCI,I) = l./A(I,I) 

IF (N .FC. 1) RETURN 

NMl = N-1 
DO 25 1=1, NMl 
IPl = I+l 
DO 25 J=IP1,N 

z(i,j) = z(i,i>*Aa,j) 

IF (J .EO. IPl) GO TO 23 
JMl = J-1 
DS = Z( I, J) 

DO 20 K=IP1,JM1 
DM = Z( I,K)*A<K,J> 

20 DS = ns ♦ DM 
Z(I,J) = DS 

23 Z(I,J) =-Z(I,J)*Z(J,J) 

25 CONTINUE 
C 

00 30 1=2, r; 

IMl = I-l 
DO 3C J=1,1M1 
30 Z( I,J) = 0. 

RETURN 


C 


999 CALL ZZBOMB 16H1NVA , NERRCR) 
END 
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SUBRCUTTNF LTAPE (NTAPEI 
DATA NIT,NC!T/5»6/ 

LIST HFADIr^GS OF MATRICES ON TAPE. 

CALLS FORMA SUBROUTINE PAGEHD. 

CODED BY RF HRUOA. JULY 1960. REVISED NOVEMBER 1970. 

REVISED BY R A PHILIPPUS. APRIL 1969. 

SUBROUTINE ARGUMENTS (ALL INPUT) 

NTAPE = NUMBER OF TAPE. (E.G. 10). 

2001 FORMAT ( //36X3SHL ISTI NG OF MATRICES ON LOGICAL UNITI3WHt TAPE A6 ) 

2002 FORMAT (//30X35HLISTING OF MATRICES ON LOGICAL UNIT13,7H, TAPE A6, 

♦ ITH (CONTINUED)) 

2003 FORMAT (27X69 (lH-)/27X3hN0.3X7HRUN N0.4X4H^IAME5X5HNR0WS^ X5HMC0LSAX 

♦ 4HDATE6X3HNNZ3X9HPARTITI0N/ 

♦ 27X3H 3X6H — ^X6H 4X5H 

♦ 4X5H 3X6H 5X3H 3X9H / ) 

2004 FORMAT f 2 5X16 ,3XA6, A-X AC ,3X1 S, 4X15 ,4XA6 t 3X15 , 3X 14, 1H/I4) 

2005 FORMAT (/27X12HEND OF l^IST.) 

REWIND NTAPE 

READ (NTAPE) TAPEID 

REWIND NTAPE 

L=C 

12 CALL PAGEHD 

I«=(L .Et. 0) WRITE (NOT, 2001) NTAPE, TAPEID 
IF(L .NE. 0) WRITE (NOT, 200?) NTAPE, TAPEID 
WRITE (NOT, 2003) 

NLINE=1 

13 L=L+1 

READ ( NTAPE ) TAPE ID ,LN, lEOTCK , IRUNNO, ANAME, NR ,NC , DATE , ITYPE ,NNZ , 

♦ NP,NPT 

IF (L .FQ. 1) ICHK = IRUNNO 
IF (ICHK .EO. IRUNNO) GO TO 15 
NL1NE=NLINE+1 
WRITE (NOT, 2004) 

ICHK = IRUNNO 

15 IF (lEOTCK .FO. 3HE0T ) GO TO 30 
REAP (NTAPE) 

IF (ITYPE .EQ. 6HDENSE ) WRITE (NOT, 2004) 

♦ LN, IRUNNO, ANAME, NR ,NC, DATE 
IF (ITYPE .10. 6HDENSE ) GO TO 20 

IF (ITYPE .EO. 6HSPARSE) WRITE (NOT, 2004) 

♦ LN , I RUNNO, AN AM E ,NR ,NC ,DATE ,NNZ 
IF (ITYPE .FQ. 6HSPARSF) GO TO 20 

IF (ITYPE .ED. 6HSPART ) WRITF (NOT, 2004) 

♦ LN, IRUNNO, ANAME, NR,NC, DATE, NNZ,NP,NPT 
IE (ITYPE -FO. 6HSPART ) GO TO 2v 

WRITE (NOT, 2004) LN , I RUNNO, AN AME ,NR ,NL, XT YPE 
20 NLINE=NLINF+1 

IF(NLINE,G1.43) GO TO 12 
GO TO 13 
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30 WRITF (NOT, 200^) LN,IECTCK 
write (N0T,?005» 

REWIND NTAPE 

RETURN 

END 
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SUBROUTINE MASSl ( PP t DM AS S » DR IN,CONC,CONVRT,Z ,NPP ,NDM,NDI ,NC, 

♦ KDM,KDI,KCtKZ) 

DIMENSION PP(1), DMASS(KDM»1> , DPIN(KDI,1), CONC(KCtl)» Z(KZtl) 
COMMON /LLIME/ NL INE f MAXL IN ,M INI 
DATA MIT,NDT/5»6/ 

CALCULATE MASS MATRIX FOR A BEAK. ASSUMES LINEAR VELOCITY FUNCTION 
BETWEEN CONSECUTIVE PANEL POINTS. 

TRANSLATION AT EACH PANEL POINT ARE THE GENERALIZED COORDINATES. 
INPUT IS DISTRIBUTED MASS, DISTRIBUTED ROTARY INERTIA, CONCENTRATED 
ITEMS, THE DISTRIBUTED DATA MAY NOT EXCEED THE PaNEL POINT LIMITS. 
THE ATTACH POINT FOP CONCENTRATED ITEMS MAY NOT EXCEED THE PANEL 
POINT LIMITS. OPTION TO OMIT DATA PY NDM,NDI, OR NC EQUAL ZERO. 

CALLS FORMA SUBROUTINES PAGE HD ,Z ZBOMB . 

CODED BY RL WC'HLFN. DECEMBER 1965, 

LAST REVISION BY PL WCHLEN. MARCH 1976. 

SUBRCUTir.E ARGUMENTS 

PP = INPUT VECTOR OF PANEL POINTS. SIZE(NPP). 

□MASS = INPUT MATRIX OF DISTRIBUTED MASS STRAIGHT LINE 

SEGMENT DA'A SIZF(NOM,4). 

COL 1 - A AT SEGMENT END 1. 

COL 2 = X AT SEGMENT END 2. 

COL 3 = MASS AT SEGMENT b'ND 1. 

COL 4 = MASS AT SEGMENT END 2. 

DPIN = INPUT MATRIX OF DISTRIBUTED ROTARY INERTIA STRAIGHT LINE 

SEGMENT DATA. SI2E«NDl,4j. 

COLUMNS ARE SIMILAR TO DMASS. 

C CONC = INPUT MATRIX ^F CONCENTRATED ITEM DATA. SIZE(NC,4). 

C COL 1 = ATTACH STATION, 

C COL 2 = MASS OF ITEM. 

C COL 3 = CENTER OF GRAVITY OF ITEM. 

C COL 4 = MOMENT OF INERTIA ABOUT CG OF ITEM. 

C CONVRT = INPUT CONVERSION SCALAR BY WHICH COL 3,4 OF DMASS, ORIN AND 

C CUL 2,4 OF CONC WILL BE MULTIPLIED. 

C Z = OUTPUT MASS MATRIX. S IZE (NPP,NPPJ . 

C NPP = INP!^ rjMFEP OF PANEL POINTS. SIZE OF VECTOR PP, MATRIX Z. 

C NDM = INPUT NUMBER OF SEGMENTS (ROWS) IN DMASS. LAN BE ZERO. 

C NOI - INPUT NUMBER OF SEGMENTS (ROWS) IN DRIN. CAN BF ZERO. 

C NC = INPUT NUMBER OF ITEMS (ROWS) IN CONC, CAN BE ZFRO. 

C KDM = INPUT ROW DIMENSION OF DMASS IN CALLING PPOGFAM. 

C KOI = INPUT ROW DIMENSION OF ORIN IN CALI ING PROGRAM, 

C KC = INPUT ROW DIMENSION OF CONC IN CALLING PROGRAM. 

C KZ = INPUT ROW DIMENSION OF Z IN CALLING PROGRAM. 

C 

C NERROR EXPLANATION 

C 1 = LESS THAN 2 PANEL POINTS. 

C 2 = PANEL POINTS NC'T IN INCREASING ORDER. 

C 3 = INCORRECT DISTRIBUTED DATA. 

C 4 = CONCENTFATED mass ATTaCH STATION (iUTSIDE PANEL 
C POINT BOUNDS. 

' 2001 ' ORyAT ( ?U/) ,3GX,31HSUPR0UT1NE MASSl USES CONVRT = E15.B, /// 

'T 3 7X,33HAND COMPUTES THF TOTAL PROPERTIES /// 

V 43X,6HM = E 13,8 ,//43X,6HXCG = E 15 .8 , //4?X , 6H1CG = 


E 15.8 ) 
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I 2050 FORMAT (/ IX 123(1H-) I 

C CHECK THAT PANEL POINTS ARE IN INCREASING ORDER. 
IF (NPP .LT. 2) GO TO 999 
DO 5 K=2»NPP 

IF (PP(X-l) .GE. PP(K)) GO TO 999 
5 C0f4TlNUE 


NERROR = 1 
NERROR = 2 


INITIALIZE DATA. 

DO 10 1=1 ,NPP 
00 10 J=1,NPP 
10 Z(I,J) = C.O 
NBAYS = NPP-1 
C 

C DISTRIPUTED NASS IMIC=1J, DIS1RIBUTED ROTARY TNERTIA (MIC=2)» 

C CONCENTRATED ITEM JMIC=3). 

DO 95 MIC=1,3 

IF (MIC .EQ. 1) NSEGS = NDM 
IF (MIC .FO. 2) NSEGS = NDI 
IF (MIC .EO. 3) NSEGS = NC 
IF (NSEGS .EQ. 0) GO TO 95 

C 

DO 90 I = T , NSEGS 
GO TCf (2! ,22, 70, MIC 

21 XI = DM ASS (1,1) 

X2 = DMASS(1,2) 

Vi = DMASS(I,3> ♦ CONVRT 
V2 = DMaSS(I,4) ♦ CONVRT 
GO TO 30 

22 XI = DRIN(I,1 ) 

X2 - DR IN (1, 2) 

VI = OR IN (1,31 * CONVRT 
V2 - DR IN (1, 4) ♦ CONVRT 

30 NERROR = 3 

IF (XI .LT. PPdl .OR. X2 .GT. PP(NPP) .OR. XI .GE. X2) GC TO 999 
DO 32 K=1,NHAYS 
IF (XI .LT. PP(K+in GO TO 34 
32 CONTINUE 
34 XP = XI 
VP = VI 

36 IE (X2 .LE. PP(K + in GO TO 38 
XC = PP(K+1) 

VQ = VI ♦ (XQ-X1)’MV2-V1)/(X2-X11 

GO TO 39 

38 XC = X2 
VQ = V? 

39 PAYL = PP(Kh11 - PP(K) 

SEGL = XC-X. 

HP = (XP- FRO' > } / PAYL 
HO = (XO--; ; . n / BAYL 
VP VC = VE ♦ VO 
GC TO <S'J,60I,MIC 
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50 FI - SEGL« VPVC/2. 

F2 = StGL*(VPV0*(HP+H0l ♦ VP*HP + V0^H0>/6, 

F3 = SEGL*(VPVt«(HP+HG)*K^2 2.*fVP#HP**2 ♦ V0*HQ*»2 D/12 . 
GO TO 8E> 

C 

60 F! = 0. 

F? = 0. 

F3 = SFGL*VPVC/(2.*BaYL*=*^2) 

GO TO 80 

C 

70 XA = CDNCihll 

NERRQP 

IF tXA -LI. PP(l) .O’-';. XA .CT. PP(NPP)) GO TO 999 
CP - rOPCd,?) * CONVRT 
riO 72 K-l,NBAYS 
ir (XA .LT. PPIK+in GO TO 75 
72 CONTmiE 
K = NBAYS 

75 PAYL = PP(K+1) - PP(KI 

HC ^ (CCNC(I,3) - Pr^KII/BAYL 
FI = CM 
F2 = CM*HC 

F3 = CM^HO#,? ♦ CONC( I,4)*C0NVRT/eAYL**2 
t 

80 L = K+1 

Z(K,K) = Z(K,K) * FI ~2.^^f2 +F3 
Z(K,U = Z(K,U + F2 - F3 
Z'L,L> = ZvL,L) + F3 
C 

IF (MIC .EG, 3 .OR. X2 .LE. PP{K+i)) GO TO 90 
K = K + 1 
XP = XO 
VP = VC 
GO TO 36 
90 CON'TIMJF 
95 CCNTIr/UF 
C 

C SYMMETRIZE. 

DO 110 K=ltNPAYS. 

110 Z(K+7»K) = Z(K,K+1) 

C 

C COMPOTE AMP PRINT TOTAL MASS PROPEf TIES- 
TM = 0. 

TP = 0. 

TI = 0. 

no 201 1 = 1 , NPO 

CO 201 J=1»NP2 
TM - TM + Z(I,J’ 

TP = TP + ? (3 ,J/ »PP(J> 

201 TT = TI ♦ PP(I)*Z(I,J)*PP(J) 

CG = TP/TM 

TI = Tl - TM*GG**2 

IF (MINI .NF. ‘‘.HMIND GO TO COO 

IF (NLINF .LF. 5 .OR. NJ.INF .GF. MAXLINl GO TO 800 
IF <(NLINE>16} .G7. MAXITN) GO TO 800 
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WRITb (NOT, 2050 1 
NLINE = NLINE ♦ 2 
GO TO PIO 
8t> C'LL PAGE HO 

81J *f^vITE (NOT,200!I CONYRT,TM,CG,TI 
INE = NLINE 14 
\CTURN 

99Y rALL ZZBf NB C6HM ''-1 .NERRORI 
X I NO 


<C 
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SUBROUTINE MASS2 (PP»DMASS,OR IN,CONC,CONVRT,Z .NPP ,NDM,NDI ^NCtNZ* 

♦ KOMtROI.KC.KZl 

DIMENSION PPdl, OMASSCKDM,!!, ORINCKDI*lIt CONCCKCtU* ZtKZ*I», 

♦ F(7), FCIOI 

COMMON /LLINE/ NLINE,MAXLIN,MINI 
DATA NIT,NOT/5,6/ 

C 

C CALCULATE MASS MATRIX FOR A BEAM- ASSUMES CUBIC VELOCITY FUNCTION 
C BETWEEN CONSECUTIVE PANEL POINTS - 

C LATERAL TRANSLATION AND ROTATION AT EACH PANEL POINT ARE THE 
C generalized COORDINATES. TRANSLATION COORDINATES ARE GROUPED FIRST 
C SIGN CONVENTION IS ROTATION = -DC LATERAL DISPI/D (AXIAL COORDINATE). 

C INPUT IS DISTRIBUTED MASS, OISTRIEUTEO ROTARY INERTIA, CONCENTRATED 
C ITEMS- THE DISTRIBUTED DATA MAY NOT EXCEED THE PANEL POINT LIMITS. 

C THE ATTACH POINT FOR CONCENTRATED ITEMS MAY NOT EXCEED THE PANEL 
C POINT LIMITS. OPTION to qMIT DATA BY NOM,NDI, OR NC EQUAL ZERO- 
C CALLS FORMA SUBROUTINES PAGEHD,ZZBOMB. 

C CODED BY RL WOHLEN. DECEMBER 1965. 

C LAST REVISION BY RL WOHLEN. MARCH 1976- 
C 

C SUBROUTINE ARGUMENTS 

C PP = INPUT VECTOR OF PANEL POINTS- SIZE(NPP). 

C DMASS = INPUT MATRIX OF DISTRIBUTED MASS STRAIGHT LINE 

C SEGMENT DATA- SIZE(NDM,4). 

C COL 1 = X AT SEGMENT END 1. 

C COL 2 - X AT SEGMENT END 2- 

COL 3 = MASS AT SEGMENT END 1. 

COL A = MASS AT SEGMETT END 2. 

DRIN = INPUT MATRIX OF DISTRIBUTED ROTARY INERTIA STRAIGHT LINE 

SEGMENT DATA. SIZE(N0I,4). 

COLUMNS ARF SIMILAR DMASS. 

CONC = INPUT MATRIX OF CONCENTRATED ITEM DATA. SIZE(NC,4). 

COL 1 = ATTACH STATION- 

COL 2 = MASS OF ITEM. 

COL 3 = CENTER OF GRAVITY OF ITEM. 

COL 4 = MOMENT OF INERTIA ABOUT CG OF ITEM. 

CONVRT = INPUT CONVERSION SCALAR BY WHICH COL 3,4 OF DMASS,DRIN AND 

COL 2,4 OF CONC WILL BE MULTIPLIED. 

Z = OUTPUT MASS MATRIX. SIZE(NZ,NZ)- 

NPP = INPUT NUMBER OF PANEL POINTS. SIZE OF VECTOR PP. 

NDM = INPUT NUMBER OF SEGMENTS (kOWS) IN DMASS- CAN BE ZERO. 

NDI = INPUT NUMBER OF SEGMENTS (ROWS) IN DRIN. CAN BE ZERO. 

NC = INPUT NUMBER OF ITEMS (ROWS) IN CONC. CAN BE ZERO. 

NZ = OUTPUT SIZE OF MATRIX Z. (NZ=2*NPP|. 

KDM = INPUT ROW DIMENSION OF DMASS IN CALLING PROGRAM. 

KDI = INPUT ROW DIM-^NSICN OF DRIN IN CALLING PROGRAM. 

KC = INPUT ROW OIM'^NSION OF CONC IN CALLING PROGRAM. 

KZ = INPUT ROW DIME.mSION OF Z IN CALLING PROGRAM. 

NERROR EXPLANATION 

1 = LESS THAN 2 PANEL POINTS. 

2 = PANEL POINTS NOT IN INCREASING ORDER. 

3 ST INCORRECT DISTRIBUTED DATA. 

4 = CONCENTRATED HASS ATTACH STATION OUTSIDE PANEL 
POINT BOUNDS. 
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2001 FORMAT « 31/) ,30X .3iHSUBR0UTINE MASS2 USES CONVRT = E15.8, /// 

♦ 37X,33HAND COMPUTES THE TOTAL PROPERTIES /// 

♦ 43X,6HM = E15.8,//43X,6HXCG = E15.8t//43X,6HICG = E15.8I 

2050 FORMAT (/ IX 123(1H~) ) 

CHECK THAT PANEL POINTS ARE IN INCREASING ORDER. 

NERROR = 1 

IF (NPP .LT. 2) GO TO 999 

NERROR = 2 

DO 5 K=2»NPP 

IF fPP(K~l) .GE. PPtK)) GO TO 999 
5 CONTINUE 


C 

c 

c 


C 


INITIALIZE DATA. 

N2 = 2*NPP 
DO 10 1=1. NZ 
DO 10 J=1.NZ 
10 Z(I»J) = 0.0 
NBAYS = NPP-1 

DISTRIBUTED MASS (MIC=1), DISTRIBUTED ROTARY INERTIA (MIC=2)t 
CONCENTRATED ITEM CMIC=3). 

DO 95 MIC=1,3 

IF CMIC .EO. II NSEGS = NDM 

IF (MIC .EO. 2) NSEGS = NDI 

IF (MIC .EO. 3) NSEGS = NC 

IF (NSEGS .EG. 0) GO TO 95 

DO 90 1=1 .NSEGS 
GO TO (21 .22. 701, MIC 

21 XI = DMASS(I.l) 

X2 = 0MASS(I.2) 

VI = DMASS(I,3) * CONVRT 
V2 = DMASS(I,4) * CONVRT 
GO TO 30 

22 XI = DRIN(I.l) 

X2 = 0RIN(1,2) 

VI = OR IN (1,3) * CONVRT 
V2 = DRIN(I,4) ♦ CONVRT 

30 NERROR = 3 

IF (XI .LT. PP(1) .OR. X2 .GT. PP(NPP) -OR. XI .GE. X2) GO TO 999 
DO 32 K=1 .NBAYS 
IF (XI -LT. PP(K+D) GO TO 34 
32 CONTINUE 
34 XP = XI 
VP = VI 

36 IF (X2 .LE. PP(K+D) GO TO 38 
XO = PP(K+1) 

VO = VI + (XQ~X1)*(V2-V1)/(X2“X1) 

GO TO 39 

38 XO = X2 
VQ = V2 

39 BAYL = PP(K+1) - PP(K) 

HP = (XP-PP(K)) / BAYL 
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HQ = IXQ-PPCK)) / 8AYL 
W = CVQ-VP)/(HQ“HP) 

DO 44 J=l,7 
JPl = J+1 
RJ = J 
RJPl = JPl 

44 E(J) = W*(HO*=^JPl - HP44JP1I/RJP1 ♦ (VP-W*HP)»(HQ*»J - HP**Jl/RJ 
GO TO (50f60)»MIC 

50 DO 55 J=lt7 

55 FU) = BfYL 4 E(J) 


F( 

8) 


F AYL 

♦ E(31 

F( 

9) 


PAYL 

* E(41 

F(10) 

=T 

EAYL 

♦ E(51 

GO 

TO 

80 



60 F( 

1 1 


0. 



F( 

2) 

— 

0. 



F( 

31 


0. 



F( 

4) 

£ 

0. 



F( 

5) 


3.*E(31 / 

BAYL 

F( 

6) 


6.*E(41 / 

BAYL 

F( 

71 


9.*E(51 / 

BAYL 

F( 

81 


E(ll / 

PAYL 

F( 

91 


2.*E(2I / 

BAYL 

F(IO) 

=: 

4.*E(31 / 

BAYL 

GO 

TO 

80 




70 XA = CONC(Itl) 

NERROR = 4 

IF (XA .LT. PPtl) .OR. XA .GT. PPfNPPlI GO TO 999 
CM = C0NC(I,2) ♦ CONVRT 
DO 72 K=1,NBAYS 
IF (XA .LT. PP(K-H)> GO TO 75 
72 CONTINUE 
K = NRAYS 

75 BAYL = PP(K+1> - PP(K) 


Cl 

= (C0NC(It4l»C0NVRTl / 

BAYL^^2 

HA 

= (XA - PP(K)1 / BAYL 



HC 

= (C0NC(I,31 

- PP(K1)/BAYL 

Pt 

= 2. 

♦HC - HA 




P2 

= 3. 

♦HC - 2. ♦HA 



F( 

11 = 


CM 



F( 

21 = 


CM^HC 



F( 

31 = 

HA * 

CM*P1 



F( 

41 = 

HA^*2 ♦ 

CM^P2 



F( 

51 = 

HA442 ♦ 

(CM4P24MC 

♦ 

3.9CI1 

F( 

61 = 

HA^%3 ♦ 

(CM4P1^P2 

+ 

6.^CI1 

F( 

71 = 

HA^+4 ♦ 

(CM^P2*42 


9.^CII 

F( 

81 = 


CM^HC^^2 

♦ 

Cl 

F( 

91 = 

HA ♦ 

(CM4P14HC 

♦ 

2.^CI1 

F(10) = 

HA442 ♦ 

(CM4P1^*2 

♦ 

4.^CI1 


80 L = K+1 
M = K+NPP 
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N = K+NPP+1 

PI =~12.*FC6) ♦ 4.*FJ7I ♦ 9.#FI10) 

P2 = 2.»FI5) - 7. ♦Fife) ♦ 2,*FC 71 - 3.*F(9) ♦ 6.’^FC10} 

P3 = ~5.*F(6) ♦ 2.»F(7) ♦ 3.*F(101 
BAYL2 = BAYL**2 

2CK,K) = ZfK,K) F fl )-6.^FC3 I♦4.♦F(4I♦P1 

ZCK, J = Z(K,LI ♦ 3.*F(3»-2.*F(4)~P1 

2(K»M) = ZCKfM) ♦ (-F (2»+2.=»'F(3l~F(4)“P2) ♦ BAYL 

2CK,N) = ZfK,N) ♦ fFC3J-Fl4»-P3l ♦ BAYL 

2(L,L) = 2(L,L» ♦ PI 

2<L*M» = Z(L,M) ♦ P2*BAYL 

Z(L*N) = ZCL»N) ♦ P3*EAYL 

2(MfM) = Z(M,M» ♦ (2.*FC5I-4.*F|6I*F(7)*F(8>-4.*F<9)+4.YFI1CI ) 

1 ♦ BAYL2 

ZtMfN) = ZCMtN) + tFt5)-3.*F(fe)+F(7)-F(9)+2,*FU0) ) ♦ BAYL2 
2IN,NJ = ZCN,N) ♦ (-2.*F(6)+F(7)+F( 10) ) ♦ BAYL2 

IF CMIC .EQ. 3 .OR* X2 *LE. PPCK+Dt 60 TO 90 
K = K+1 
XP = XC 
VP = VO 
60 TO 36 
90 CONTINUE 
95 CONTINUE 

SYMMETRIZE. 

DO 110 1=1, NZ 
DO 110 J=I,NZ 
110 Z(J*I) = Z(I,J) 

COMPUTE AND PRINT TOTAL MASS PROPERTIES* 

TM = 0. 

TP = 0. 

TI = 0. 

DO 201 1=1, NPP 
K = I NPP 
DO 201 J=1,NPP 
L = J ♦ NPP 
TM = TM ♦ 2(1, J) 

TP = TP - 2(K,J) ♦ 2(I,J)*PP(J) 

201 Tl = TI ♦ PP(I)*ZCI,J)*PP(J) - 2.*2(L,I )»PP(I ) ♦ ZIK,L» 

CG = TP/TM 

TI = TI - TM4CG**2 

IF (MINI *NE* 4HM1NI) GO TO 800 

IF (NLINE .LE. 5 .OR. NLIN'^ .GE. MAXLIN) GO TO 800 
IF ((NLINE+16) .GT. MAXLIN) GO TO 800 
WRITE (NOT, 2050) 

NLINE = NLINE + 2 
GO TO 810 
800 CALL PAGEHD 

810 WRITE (NOT, 2001) CONVRT,TM,CG,TI 
NLINE = NLINE ♦ 14 
RETURN 

999 CALL ZZBOMB (6HMASS2 ,NERROR) 
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SUBROUTINE MASS2A (PP,DMASS,SMASSfFLEVELfCONVRTfI.NPP,NDM,N2, 

♦ KDM.KZI 

DIMENSION PP(l), DMASS(KDM,1) , Z(KZ»l)r F(7) 

COMMON /LLINE/ NL INE,MAXLIMtMINI 
DATA NIT*NOT/5,6/ 

C 

C CALCULATE MASS MATRIX FOR FLUID IN A CONTAINER. INCLUDES COUPLING 
C BETWEEN DISTRIBUTED MASS AND SLOSH MASS. ASSUMES CUBIC FUNCTION 
C BETWEEN CONSECUTIVE PANEL POINTS TO DESCRIBE CONTAINER LATERAL 
C VELOCITY AND ASSUMES UNIFORM SLOSH MOTION RELATIVE TO THE CONTAINER. 

C LATERAL TRANSLATION AND ROTATION AT EACH PANEL POINT AND THE SLOSH 
C AMPLITUDE ARE THE GENERALIZED COORDINATES. TRANSLATION COORDINATES 
C ARE FIRST, ROTATION COORDINATES NEXT, THE SLOSH COORDINATE LAST. 

C SIGN CONVENTION IS ROTATION = -0(LATERAL DISP»/D(AXIAL COORDINATE!. 

C INPUT IS THE FLUID DISTRIBUTED MASS, THE FLUID SLOSH MAS? , AND THE 
C FLUID LEVEL. THE DISTRIBUTED MASS MAY NOT EXCEED THE PANEL POINT 
C LIMITS. THE FLUID LEVEL MAY NOT EXCEED THE DISTRIBUTED MASS LIMITS. 

C CALLS FORMA SUBROUTINES PAGEHD,ZZBOMB. 

C CODED BY C BODLEY. MAY 1966. 

C LAST REVISION BY RL WOHLEN. MARCH 1976. 

C 

C SUBROUTINE ARGUMENTS 

C PP = INPUT VECTOR. OF PANEL POINTS. SIZE(NPP). 

C DMASS s INPUT MATRIX OF DISTRIBUTED MASS STRAIGHT LINE 

C SEGMENT DATA. SIZECNDM,4). 

■C COL 1 = X AT SEGMENT END 1. 

COL 2 = X AT SEGMENT END 2. 

Ic COL 3 = MASS AT SEGMENT END 1. 

C COL 4 = MASS AT SEGMENT END 2. 

C DMASS{I,2) MUST EQUAL DMAS S < I+l, 1 I , ETC. 

C SMASS = INPUT SLOSH MASS. Z(NZ,NZ! OF OUTPUT MASS MATRIX. 

C FLEVEL = INPUT FLUID LEVEL. MUST BE WITHIN DMASS LIMITS. 

C CONVRT = INPUT CONVERSION SCALAR BY WHICH COL 3,4 OF DMASS WILL BE 

C MULT1IPLIED. 

C Z = OUTPUT MASS MATRIX. SIZE(NZ,NZ). 

C NPP = INPUT NUMBER OF PANEL POINTS. SIZE OF VECTOR PP. 

C NOM = INPUT NUMBER OF SEGMENTS (ROWS! IN DMASS. 

C NZ = OUTPUT SIZE OF MATRIX Z. (NZ=2»NPP+1 ) . 

C KDM = INPUT ROW DIMENSION OF DMASS IN CALLING PROGRAM. 

C KZ = INPUT ROW DIMENSION OF Z IN CALLING PROGRAM. 

C 

C NERROR EXPLANATION 

C 1 = LESS THAN 2 PANEL POINTS. 

C 2 = PANEL POINTS NOT IN INCREASING ORDER. 

C 3 = FLUID LEVEL OUTSIDE DISTRIBUTED MASS BOUNDS. 

C 4 = DISTRIBUTED MASS HAS GAPS. 

C 1> = DISTRIBUTED MASS EXCEEDS PANEL POINT BOUNDS. 

C 

2001 FORMAT ( 3 ( /) ,30X ,32HSUBRCUTI NE MASS2A USES CONVRT = E15.8, // 

* 4PX,13HSLCSH MASS = E 15 .8 ,//48X , 14HFLUID LEVEL = E15.8,/// 

♦ 37X,33HAND COMPUTES THE TOTAL PROPERTIES /// 

* 43X,6HM = E15.8,//43X,6HXCG = E15.8 ,//43X,6HICG = EI5.8) 

2050 FORMAT (/ IX 123(1H-) ) 

CHECK THAT PANEL POINTS ARE IN INCREASING ORDER. 
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IF (NPP .LT. 21 GO TO ®99 
DO 5 K=2fNPP 

IF (PP(K-1I .GE. PP(K)1 GO TO 999 
5 CONTINUE 


NERROR = 1 
NERROR - 2 


CHECK DISTRIBUTED MASS MATRIX. 

NERROR 

IF (FLEVEL.LT.OMASSn,!! .OR. FLEVEL.GE .DMASS <NDM ,2 II GO TO 
IF (NDM .EQ. 1) GO TO 9 
NDMMl = NDM-1 


NERROR 

DO 7 1=1, NDMMl 

IF (DMASS(I,2) .NE. DMASS(I-H,in GO TO 999 
7 CONTINUE 


= 3 
999 


= 4 


INITIALIZE DATA. 

9 NZ = 2»NPP+1 
DO 10 1=1, NZ 
DO 10 J=1,NZ 
10 Z(IfJ) = 0.0 
NBAYS = NPP-1 

DO 15 JM = 1,NDM 

IF (FLEVEL .LT. DMA5S(JM,2)) GO TO 16 

15 CONTINUE 

16 DMJl = DMASS(JM,1» 

0MJ3 = DMASS(JM,3I 
DMASS<JM,1I = FLEVEL 

DMASS(JM,3I = DMJ3 + CFLEVEL - DMJl I ♦ (DMASS(JM,4} - DMJ3)/ 

♦ (DMASS(JM,2I - DMJll 

DO 90 I = JM,NDM 
XI = 0MaSS(I,1) 

X2 = DMASS(I,2I 

VI = DMASSfI,3l * CCNVRT 

V2 = 0MASS(I,4) 4 CONVRT 

NERROR = 5 

IF <Xl .LT. PP(l) .OR. X2 .GT. PPfNPPI .OR. XI .GE. X2I GO TO 999 
DO 32 K=l,NBAYS 
IF CXI .LT. PP(K+in GO TO 34 
32 CONTINUE 
34 XP = XI 
VP = VI 

36 IF CX2 .Lt. PPCK+in GO TO 38 
XQ = PPCK41) 

VO = VI + CXQ-X1I*(V2-V1I/(X2->X1} 

GO TO 39 

38 XO = X2 

VQ = V2 

39 BAYL = PPCK+l) - PPCK ) 

HP = CXP-PPCKM / BAYL 

HQ = fXO-PPCK)) / BAYL 

W = (VQ-VPI/CHO-HP) 
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DO 44 J=l,7 
JPl = J+1 
RJ = J 
RJPl = JPl 

44 F(J) = (W*(HQ**JP1 - HP»*JP1)/RJP1 + (VP-W*HP)*(HQ**J - HP**J)/RJ) 
♦ * BAYL 

C 

L = K+1 
M s K+NPP 
N = K+NPP+1 

PI = 9.*F(5) - 12.*F(6) ♦ 4.*F(7) 

P2 =-3.*F(4) + 8.*F(5) - 7.*F(6» + 2.4F(7) 

P3 = 3.*F(5) - 5.*F(6) + 2.4F(7) 

BAYL2 = BAYL**2 

2(K,K) = Z<K,K) + F(1 )-6,*F(3l+4.^F(4»+Pl 

Z(K»L) = Z(K,U + 3.*F(3I“2.*F(4I-P1 

Z(K,M) = Z(K,M) + (-F C2)+2**F(3J~F<4)-P2> ♦ BAYL 

Z(K,NI = Z(K,NI + (F<3I-F(4»-P3> ♦ BAYL 

Z(L»LI = Z(LtL) ♦ PI 

Z(L»MJ = Z(L,M» ♦ P2*BAYL 

Z(L,N) = ZIL,N) ♦ P3*BAYL 

Z(M,M» = Z(M,M) ♦ (F(3l-4.*FC4)+6.*Ff5l-4.*Ff6) +Ff7n * BAYL2 
Z(M,N) = Z(M,N| + (-F<4) 43.*FI5|-3.*FC6)+Fl7n ♦ BAYL2 
Z(NfN) = ZfNfNt + (F(5)-2.^F(6)+F(7)) ♦ BAYL2 
Z(K,NZ) = Z<KtNZ) + Ffl)~3.*Ff3)+2.*F(4) 

ZiLtNZt = Z(LtNZ) ♦ 3.*FC3)-2.*F|4) 

Z(M,NZ) = Z(M,NZ) + (-F(2)+2.*FC3»-F(4n ♦ BAYL 
Z(N»NZ) = 2(NfNZ) + fFC3)“FC4)) ♦ BAYL 
Z(NZ,MZ) = Z(NZ,NZ) + F(l) 

C 

IF (X2 .LE. PPtK+l)> GO TO 90 
K = K+1 
XP = XC 
VP s VO 
GO TO 36 
90 CONTINUE 
C 

DMASS(JM,n = DMJl 
DMASS(JM»3) = DMJ3 

P = SMASS/Z(NZ,NZ) 

DO 95 I-T,NZ 
95 Z(I,NZ) = Z(ItNZI*R 
Z(NZ,NZ) = SMASS 

SYMMETRIZE. 

DO 110 1=1, NZ 
DO 110 J=I,NZ 

110 z(j,n = z(i,j) 

COMPUTE AND PRIN' TOTAL MASS PROPERTIES. 

TM = 0. 

TP = 0. 

TI = 0. 

DO 201 1=1, NPP 
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K = I + NPP 
00 201 J=1,NPP 
L = J ♦ NPP 
TM = TM + 2(I,J) 

TP = TP - Z(K,J) Z(I,J)*PP(JJ 

201 TI = TI ♦ PP(I)»Z<I,JJ*PP{J) ~ 2-*2<LfI )*PP(II ♦ 2(K,L> 
C6 = TP/TM 
TI = TI “ TM^CG^^Z 
IF (MINI .NE. AHMINI) GO TO 800 

IF (NLINE .LE, 5 .OR. NLINE .GE. MAXLIN) GO TO 800 
IF ((NLlNF+201 .GT. MAXLIN) GO TO 800 
WRITE (N0T,2050) 

NLINE = NLINE + 2 
GO TO 810 
800 CALL PAGEHD 

810 WRITE (NOT, 2001) CONVRT,SMASS,FLEVEL,TM,CG,TI 
NLINE = NLINE 18 
RETURN 

999 CALL ZZBOMB ( 6HMASS2A ,NERROR) 

END 
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SUBROUTINE MOOFl IA,S tW2,W,FREQ,N,FOD,KR,NUTl ) 

DIMENSION A<KR,1I, S(KRtl)f W2mf Wdl* FREQIl) 

COMMON /LLINE/ NL INE,MAXL IN,MINI 
DATA NIT, NOT/5, 6/ 

C 

C CALCULATE MODE SHAPES <PHI ) AND NATURAL FREQUENCIES OF 
C (A)**-1(S) (PHI ) = (PHIM~W2-) USING METHOD OF JACOBI. 

C THE MASS (Al MATRIX MUST BE REAL, SYMMETRIC, POSITIVE DEFINITE. 

C THE STIF (S) MATRIX MUST BE REAL, SYMMETRIC. 

C THE FIRST ELEMENT OF EACH MODE SHAPE IS MADE POSITIVE. 

C ORTHOGONALITY CHECKS — ( PHI I T* (MASSIF ( PHI I AND C PHII T*( STIF !♦ (PHI ) — 

C ARE CALCULATED AND PRINTED. 

C CALLS FORMA SUBROUTINES BTABA,BTA6A2,OCOMl ,EIGN1 ,INV4,PAGEHD, (ZIBOMB } . 
C THE MAXIMUM SIZE IS 

C N = 500 (BASED ON BTABA, BTABA2I. 

C DEVELOPED BY RL WOHLEN. APRIL 1969. 

C LAST REVISION BY RL WOHLEN. MARCH 1976. 

C 

C SUBROUTINE ARGUMENTS 

C A = INPUT MASS MATRIX. SIZE(N,N). *DESTROYED* 

C = OUTPUT MODE SHAPES. SIZE(N,N). 

C S = INPUT STIFFNESS MATRIX. SIZE(N,NI. ♦DESTROYED^ 

C W2 = OUTPUT VECTOR OF EIGENVALUES (OMEGA SQUARED). SIZE(N). 

C W = OUTPUT VECTOR OF CIRCULAR FREQUENCY (OMEGA). SIZE(N). 

C FREQ = OUTPUT VECTOR OF FREQUENCY (0MFGA/2PI). SIZE<N). 

C N = INPUT SIZE OF MATRICES A,S AND VECTORS W2,W,FREQ. MAX=500. 

I FOO = INPUT FINAL OFF-DIAGONAL VALUE FOR DYNAMIC MATRIX. 

IF FCD .LE. ZERO, THE VALUE OF FOD WILL BE CALCULATED 
AUTOMATICALLY IN SUBROUTINE EIGNl. 

KR = INPUT ROW DIMENSION OF A,S IN CALLING PROGRAM. 

NUTl = INPUT NUMBER OF UTILITY TAPE. (EG 4). 

2001 FORMAT ( 3(/) 54X ,18H (SUBROUTINE MODEl) 

♦ /// 47X,3-WTHE FO I LOWING ORTHOGONALITY CHECKS 

♦ // 52X,23H(M(30ES)T*(MAoS)*(MP0FS) 

♦ / 52X,23H(MODES)T*(STIF)*(MOOES) 

♦ // 48X,32HARE A RESULT OF THIS SUBROUTINE.) 

2002 FORMAT (// 10X,10 (7X, 1H( , 12 ,1H) ) ) 

2011 FORMAT ( ///10X,39HTHE ( MODE S ) T*( MASS )*( MOOES ) CHECK GIVES 

*: ///10X,25HTHE DIAGONAL ELEMENTS ARE // (13X ,10F11 .8) ) 

2012 FORMAT (// 10X,35HTHE MAXIMUM OFF-DIAGONAL ELEMENT IS 

♦ Ell. 3, 2X, 4HAT ( 13, IH, 13, IH) ) 

2020 FORMAT ( ///10X,28HTHE OMEGA SQUARED VALUES ARE // ( 13X, 10E11.3) ) 

2021 FORMAT ( ///lOX ,39HTHE (MODE S) T*(STIF )♦( MOOES ) CHECK GIVES 

♦ ///10X,48HTHE ABSOLUTE PERCENT DIFFERENCE IN THE DIAGONAL 

♦ 31HELEMENTS FROM OMEGA SQUARED ARE //( 13X,10F11 .8 ) ) 

2022 FORMAT (// 10X,48HTHF LARGEST OFF-DIAGONAL ELEMENT IN EACH ROW ARE 

♦ // (13X,10E11 .3)) 

2050 FORMAT (/ IX 123 (1H-) ) 

C 

IF (MINI .NE. 4HMIN1) GO TO 810 

IF (NLINF .LE. 5 -OR. NLINE .GE. M»>>L1N) GO TO 810 
IF ( (NLINF+'»*1? ) .GT. MAXLIN) GO TL 810 
WRITE (NOT, 2050) 

NLINE = NLINE ♦ 2 
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GP TC 811 

810 CALL PAGEHD 

811 WRITE (NOT, 2001) 
NLINE = NLINE ♦ 12 

CALL RWNC (NUTl) 


CALL OUT (NUT1,A,KR*N) ADMASS 

CALL OUT (NUT1,S,KR»N) S=STIF 

C 

CALL DCOMl (A,A,N,KR| A-U 

CALL TNVA^ (A,A,N,KR) A=U»’*'“1 

CALL BTABA2 (S,A,N,KR) S=DYNMAT 

CALL EIGNl (S,W2,A,-N,F00,KR) W2=W2 

A=PHI 


ALIGN THE CIRCULAR FREOUENCV SQUARED (W2) INTO INCREASING ORDER AND 
THE MODE SHAPES CORRESPONDINGLY. 

IF (N .EQ. 1) GO TO 40 
NMl = N-l 
DO 35 J=1,NM1 
W2MIN = W2(J) 

IMIN = J 
JPl = J+1 
DO 30 I=JP1,N 

IF (W2MIN ,LE. W2(I)I GO TO 30 
W2MIN = W2(I) 

IMIN = I 
30 CONTINUE 

IF (IMIN .EC. J) GO TO 35 
W2(IMIN) = W?(J) 

W2(J) = W2MIN 

DO 34 K=1,N 
AKJ = A(K,J) 

A(K,J) = A(K,IMIN) 

34 AIK, IMIN) = AKJ 

35 CONTINUE 

MAKE THE FIRST ELEMENT OF EACH MODE SHAPE POSITIVE- 
40 DO 45 J=1,N 

IF (A(1,J) .GE. 0.) GO TO 45 
DO 4? 1=1, N 
42 A(I,J) = -A(I,J) 

45 CONTINUE 

CALCULATE (PHI )T*(MASS )♦ (PHI ) ORTHOGONALITY CHECK. 

CALL RWND (NUTl) 

CALL IN (NUT1,S,KR»N) S=MASS 

CALL RTABA ( S, A,N,N,KR,KR) S=PMP 

XOFF = 0. 
lOFF = 1 
JOFF = 2 
DO 54 1=1 ,N 
i DO 5? J=I,N 

IF (I .EQ. J) GO TO 52 

IF (ABS(XOFF) .GE. ABS(S(I,J))) GO TO 52 
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XOFF = S(I,J) 
lOFF = I 
JDFF = J 
52 CONTINUE 
54 CONTINUE 
NPL = N/10 

IF ((NPL*10I .NE. Nl NPL = NPL-t-i 
IF (MINI .NE. 4HMINI) GO TO C20 

IF (NLINE .LE. 5 .OR. NLINE .GE. MAXLIN) GO 0 820 
IF ((NLINE+2+14+NPLI .GT. MAXLIN) GO TO 820 
WRITE (NOT, 20 50) 

NLINE = NLINE + 2 
GO TO 821 

820 CALL PAGEHD 

821 WRITE (NOT, 2002) (JC,JC=1,10) 

WRITE (NOT, 2011) (S (I , I ) , I=1,N) 

WRITE (NOT, 2012) XOFF ,IOFF, JOFF 
NLINE = NLINE + 14 + NPL 

CALCULATE ( PHI )T*( STIF )* (PHI ) ORTHOGONALITY CHECK. 
CALL IN (NUTl ,S,KR*N) 

CALL BTABA ( S,A,N,N,KR,KR) 

DO 64 1=1 ,N 
W(I) = 0. 

DO 62 J=1,N 

IF (I .FO. J) GO TO 62 

IF (APS(S(I,J)) .GT. ABS(W(im W(I)=S(I,J) 

62 CONTINUE 
64 CONTINUE 

IF (MINT .NE. 4HM1WI) GO TO 830 

IF (NLINE .LE. 5 .OR. NLINE .GE. MAXLIN) GO TO 830 
IF ( (NLINE+2+20+3*NPL ) .GT. MAXLIN) GO TO 830 
WRITE (NOT, 2050' 

NLINE = NLINE + 1 
GO TO 831 

830 CALL PAGEHD 

831 WRITE (NOT, 2002) (JC,JC=1,10) 

WRITE (NOT, 2020) (W2(I), 1=1, N) 

NLINE = NLINE + 8 + NPL 

DO 66 I*-1,N 

IF (W2(I) .LE. 0.) GO TC^ 68 

S(I,I) = ABS(S(I,I)-W2(I) )*100./W2(I) 

68 CONTINUE 

WRIiF (WOT, 2021) (S(I,I), I=1,N) 

WRITE (NOT, 2022) (W(I), 1=1 ,N) 

NLINE = NLINE + 12 ♦24NPL 

DO 72 1=1 ,N 

W(I) = SORT (ABS(W2(im 
72 FREQ(I)= .15915494 ♦ W(I) 

RETURN 

END 


S=STIF 

S=PSP 
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SUBROUTINE MODEIA ( A* S,W2*W,FRE0,N« FOO.KR »NUT1 ) 

DIMENSION A(KR,1), S(KR,1), Will, FREQdl 

COMMON /LLINE/ NLINE,MAXLIN ,MINI 
DATA EPS/1. E-30/ 

DATA NIT,N0T/5,6/ 

C 

C CALCULATE MODE SHAPES tPHII AND NATURAL FREOUENCIES OF 
C ICfAl^(S) (AMPHI) = (PHI) (-l/fC+W?)~) USING METHOD OF JACOBI. 

C THE HASS (A) MATRIX MUST BE REAL, SYMMETRIC, POSITIVE DEFINITE. 

C THE STIF (S) MATRIX MUST BE REAL, SYMMETRIC, 

C THE FIRST ELEMENT OF EACH MODE SHAPE IS MADE POSITIVE. 

C ORTHOGONALITY CHECKS — ( PHI ) T^IMASS )♦( PHI ) AND < ?HIIT*(STIFI»(PHI I — 

C ARE CALCULATED AND PRINTED. 

C CALLS FORMA SUBROUTINES BTABA,BTATA2,DCOMI ,EIGNl,INV4,PAGEH0, (2ZBOMB ). 
C THE MAXIMUM SIZE IS 

C N = 500 (BASED ON BTAB A, 6TAB A2) . 

C DEVELOPED BY RL WOHLEN. APRIL 1969. 

C LAST REVISION BY RL WOHLEN. MARCH 1976. 

C 

C SUBROUTINE ARGUMENTS 

C A = INPUT MASS MATRIX. SIZE(N,N). *DESTROYED* 

C = OUTPUT MODE SHAPES. SIZE(N,N). 

C S = INPUT STIFFNESS MATRIX. SIZE(N,N). ♦DESTROYED* 

C M2 = OUTPUT VECTOR OF CIRCULAR FREOUENCY SQUARED. SIZE(N). 

CM = OUTPUT VECTOR OF CIRCULAR FREOUENCY (OMEGA). SIZE(N). 

C FREO = OUTPUT VECTOR OF FREQUENCY (0MEGA/2PI). SIZE(N). 

1 N = INPUT SIZE OF MATRICES A,S AND VECTORS W2,W,FREC. MAX=500. 

FOD = INPUT FINAL CFF-OIAGONAL VALUE FOR DYNAMIC MATRIX. 

IF FOD .LE. ZERO, THE VALUE OF FOD WILL BE CALCULATED 
AUTOMATICALLY IN SUBROUTINE EIGNi. 

KR = INPUT ROW DIMENSION OF A,S IN CALLING PROGRAM. 

NUTl = INPUT NUMBER OF UTILITY TAPE. (EG A^). 

2001 FORMAT ( 3(/) 54X ,19H (SUBROUTINE MOOEIA) 

♦ /// 38X,37HTHE CALCULATED COMBINATION VALUE = E15.8, 

♦ /// 47X,3AHTHE FOLLOWING ORTHOGONALITY CHECKS 

♦ // 52X,23H (MODES )T*(MASS)*(MODFS) 

♦ / 52X,23H(MOOES)T*(ST1F)*(MOOES) 

♦ // A8X,32HARE A RESULT OF THIS SUBROUTINE.) 

2002 FORMAT (// lOX, 10 (7X, IH ( , 12 ,1H) ) ) 

2011 FORMAT ( ///lOX ,39HTHE ( MODES) T*(MASS )♦( MOOES ) CHECK GIVES 

» ///10X,25HTHE DIAGONAL ELEMENTS ARE // (13X ,10F11.8) ) 

2012 FORMAT (// 10X,35HTHE MAXIMUM OFF~D»^AGONAL ELEMENT IS 

♦ Ell .3, 2X, 4HAT ( 13, IH, 13, 1H| ) 

2020 FORMAT (///10X,28HTHE OMEGA SQUARED VALUES ARE // ( 13X, lOEll .3) ) 

2021 FORMAT ( ///10X,39HTHE ( MOOES) T* (STIF)*( MODES) CHECK GIVES 

♦ ///10X,48HTHE absolute PERCENT DIFFERENCE IN THE DIAGONAL 

♦ 31HELEMENTS FROM OMEGA SQUARED ARE //( 13X, lOFll .8 ) ) 

2022 FORMAT (// 10X,48HTHE LARGEST OFF-DIAGONAL ELEMENT IN EACH ROW ARE 

♦ // (13X,10E11 .3)) 

2050 FORMAT (/ IX 123(1H~) ) 

ANOPM = 0.0 
SNORM =0.0 
DO 5 1=1, N 



u o 
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C 


c 


c 


c 


00 5 J-l.N 

ANORM = ANPRM ♦ ABS(A(I«J)1 
5 SNORM = SNORM ♦ ABS(SfI»J)l 
C = SNORM/ANORM 

IF CMINI .NE. AHMINI) GO TO 810 

IF (MLINE .LE. 5 .OR. NLINE .GE. MAXLIN) GO TO 810 
IF (fNLINE+2^15 » .GT. MAXLIN I GO TO 810 
WRITE (N0T,205O) 

NLINE = NLINE + 2 
GO TO 811 

810 CALL PAGEHO 

811 WRITE (NOT, 20011 C 
NLINE = NLINE ♦ 15 


CALL RWND (NOTH 

CALL OUT (NUT1,A,KR*N) 

CALL OUT (NUT1,S,KR»NI 

DO 12 1=1 ,N 
DO 12 J=1,N 

12 A(I,J) = S(I,JI ♦ C*A(I,JJ 


CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
DO 28 


OCOMl 

1NV4 

RWND 

IN 

BTABA2 
EIGNl 
J=1 ,N 


(A,A,N,KR) 

(A,A,N,KR1 

(NUTII 

(NUT1,S,KR^NI 
(S,A,N,KR I 
CS,W2,A,-N,FOO,KRI 


28 


Cl = S0RT(W2(JII 
DO 28 1=1, N 
A(I,J) = A(I,J)/C1 


A=MASS 

S=STIF 


A=SCM 


A=U 

A=U*=F~1 

S=MA£S 

S=DYNMAT 

W2=VAL 


A=PHI 


CALCULATE W2. 

DO 2P 1=1, N 

IF (W2<n .LT. EPS» W2(I»=EPS 

29 W2(II = l./W2(II ~ C W2=W2 

C 

C ALIGN THE CIRCULAR FREQUENCY SQUARED fW2) INTO INCREASING ORDER AND 
C THE MODE SHAPES CORRESPONDINGLY. 

IF (N .EO. II GO TO 40 
NMI = N-1 
DO 35 J=1 ,NM1 
W2MIN = W2(J) 

IMIN = J 
JPl = J+1 
DO 30 I=JP1,N 

IF (W2MIN .LE. W2(ll) GO TO 30 
W2MIN = W2(I) 

IMIN = I 

30 CONTINUE 

IF (IMIN .EQ. Jl GO TO 35 
W2(IMINI = W2(JI 
W2(J) = W2MIN 
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DO 34 K=1,N 
AKJ = A(K*JI 
A(K,J> = A(K,IMINJ 

34 A(K,IMIN) = AKJ 

35 CONTINUE 

MAKE THE FIRST ELEMENT OF EACH MODE SHAPE POSITIVE. 

40 DO 45 J=l,N 

IF <A(1»JI .GE. 0.1 GO TO 45 
DO 42 1 = 1, N 
42 ACI.JI = -A(I,J) 

45 CONTINUE 

CALCULATE < PHI )T*f MASS (PHI I ORTHOGONALITY CHECKi. 

CALL RWNO (NUTII 

CALL IN INUT1,S,KR*N| S=MASS 

CALL BTABA (S,A,N,N,KR,KRI S=PMP 

XOFF = 0. 

ICFF = 1 

JOFF = 2 

DO 54 1=1 ,N 

DC 52 J=I,N 

IF (I .EQ. J» GO TO 52 

IF (ABSfXPFFI .GE. ABS(S(I,J))) GO TO 52 
XOFF = S( I,J) 
lOFF = I 
JOFF = J 
52 CONTINUE 
54 CONTINUE 
NPL = N/10 

IF KNPL^IO) .NE. N» NPL = NPL+I 
IF (MINI .NE. 4HMINII GO TO 820 

IF (NLINE .LE. 5 -OR. NLINE -GE. MAXLIN) GO TO 820 
IF ((NLINE+2+I4+NPL) -GT. MAXLIN) GO TO 820 
WRITE (NOT, 2050) 

NLINE = NLINE ♦ 2 
GO TO 821 

820 CALL PAGE HD 

821 WRITE (NOT, 2002) (JC,JC=1,10) 

WRITE (N0T,201I) (S (I ,I ),I=I,N) 

WRITE (N01,2012) XOFF ,IOFF, JOFF 
NLINE = NLINE ♦ 14 ♦ NPL 

CALCULATE (PHI )T*(STIF )♦ (PHI ) ORTHOGONALITY CHECK. 

CALL IN (NUTl ,S,KR*N) S=STIF 

CALL BTABA ( S, A,N,N,KR,KR) S=PSP 

DO 64 1=1 ,N 
W(I) = 0. 

DO 62 J = 1,N 

IF (I -EC. J) GO TO 62 

IF (ABS(S(I,J)) .GT. ABS(W(I))) W(I)=S(I,J) 

62 CONTINUE 
64 CONTINUE 

IF (MINI .NE. 4HM1NI) GO TO 830 

IF (NLINE .LE. 5 .OR. NLINE -GE. MAXLIN) GO TO 830 
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IF l(NLINE+?+20+34NPL» .GT. MAXLINl GO TO 830 
WRITE <NOT.?050) 

NLINE = NLINE + 2 
GO TO 831 

830 CALL PAGEHD 

831 WRITE (NOT, 2002) (JC,JC=l,lO) 

WRITE (NOT,2020) (W2( I) , 1=1, N) 

NLINE = NLINE ♦ 8 ♦ NPL 

DO 68 1=1 ,N 

IF (W2(l) .LE. O.) GO TO 66 

S(I,I) = AES(S(I,I)-W2(I))4100./W2(I) 

68 CONTINUE 

WRITE (NOT, 2021) (S(I,I), I=1,N) 

WRITE (NOT, 2022) (W(I), I=1,N) 

NLINE = NLINE + 12 +2*NPL 

DO 72 1 = 1, N 

W(I) = SORT (ABS(W2(I))) 

72 FRBQ(I)= .15915494 * W(I) 

RETURN 

END 
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SUBROUTINE MOOEIB ( A«E«W2tM,FREQ,N,FODfKR«NUTl} 
DIMENSION A(KRt 1)« ECKR,1), W2CII, Wm» FREOIl) 
COMMON A LINE/ NLINE, MAXL IN .MINI 
DOUBLE PV.ECISION S.SS.2ER0 
DATA E?5/1.E-30/, ZERO/O.D/ 

DATA N^:»NOT/5.6/ 


C 

C CALCULATE MODE SHAPES IPHI) AND NATURAL FREQUENCIES OF 
C (EMAM«H'iH = (PHlH-l/W2-) USING METHOD OF JACOBI. 

C THE MASS (t| MATRIX MUST BE REAL, SYMMETRIC, POSITIVE DEFINITE. 

C THE FLEX (El MATRIX MUST BE REAL, SYMMETRIC. 

C THE FIRST fLEMENT OF EACH MODE SHAPE IS MADE POSITIVE. 

C RIGID BODY MOOES WILL BE IN THE LAST POSITIONS. 

C ORTHOGONAL TY CHECKS — (PHI IT’MMASS !♦ (PHI I AND 

C (PHIIT*(MA S)*(FLEX)^(MASS)*(PHII — ARE CALCULATED AND PRINTEO- 
C CALLS FORML SUBROUTINES 6TABA,DC0M1 ,EIGN1, INV4,MULTA,PAGEHD, (ZZBOMB I . 
C THE MAXIMUM SIZE IS 

C N = 500 (BASED ON BTABA ,MULTA) . 

C DEVELOPED PY RL WOHLEN. APRIL 1969. 

C LAST REVISION BY RL WOHLEN. MARCH 1976. 

C 

C SUBROUTINE ARGUMENTS 

C A = INPUT MASS MATRIX. SIZE(N,N). ♦DESTROYED* 

C = OUTPUT MODE SHAPES. SIZE(N.N). 

C E = INPUT FLEXIBILITY MATRIX. SIZE(N,N). *DESTROYED* 

C W2 = OUTPUT VECTOR OF CIRCULAR FREQUENCY SQUARED. (INVERTED 

EIGENVALUES). SIZE(NI. 

C W = UUTPUT VECTOR OF CIRCULAR FREQUENCY (OMEGA). SIZE(N). 

C FREQ = OUTPUT VECTOR OF FREQUENCY (0MEGA/2PI). SIZE(N). 

C N = INPUT SIZ*" OF matrices A,E AND VECTORS W2,W,FREQ. MAX-500. 

C FOD = INPUT FINAL OFF-DIAGONAL VALUE FOR DYNAMIC MATRIX. 

C IF FOD .LE. ZERO, THE VALUE OF FOD WILL BE CALCULATED 

C AUTOMATICALLY BY SUBROUTINE EIGNl. 

C KR = INPUT ROW DIMENSION OF A,E IN CALLING PROGRAM. 

C NUTl = INPUT NUKiiER OF UTILITY TAPE. (EG 4). 

C 


2001 FORMAT 
♦ 

♦ 

♦ 

♦ 

2002 FORMAT 

2011 FORMAT 
♦ 

2012 FORMf 

♦ 

2020 FO. MAT 

2021 FORMAT 

♦ 

♦ 

♦ 

2022 FjRMi '• 
2050 FORMAT 


( 3t/) 54X, 19)1 (SUBROUTINE MOOEIB) 

/// 4TX 'AHTHE FOLLOWING ORTHOGONALITY CHECKS 
// ,23H (MODES )T*(MASS )♦(MDOFS ) 

/ >X,37H (MOOES )T*(MASS )*(FLEX )*(MASS )*(MOOES ) 

// 48X.32HARE A RESULT OF THIS SUBROUTINE.) 

(// 10X,10(7X,1H(,I2,1H))) 

(, //10X,39HTHE (MODES) T*(MASS)*( MOOES I CHECK GIVES 
///10X.25HTHE DIAGONAL ELEMENTS ARE // ( 1 3X, lOFll .8 ) ) 

(// 10X.35HTHE MAXIMUM OFF-DIAGONAL ELEMENT IS 
Fli.3, 2X, 4HAT ( 13, IH, 13, IH) ) 
(///10X,32HTHE 1/(0MEGA SQUARED) VALUES ARE//(13X,10E11.3) ) 
(///lOr.ABHTHE (MOOES)T*(MASS)*(FLEX)*(MASS)*(MODES) CHECK 
5HGTVES ///10X.39HTHE ABSOLUTE PERCENT DIFFERENCE IN THE 
^'.HOIAGONAL ELEMENTS FROM 1/(0MEGA SQUARED) ARE 
//(I3X,10F11.8>) 

(// 10X.48HTHE LARGEST OFF-DIAGONAL ELEMENT IN EACH ROW ARE 
// (13X,10E11 .3)) 

(/ IX 123(IH-I ) 


C 
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C 


c 

c 

c 

c 


c 

c 


c 

c 

c 




IF (MINI .NE. 4HMINI) GO TO 810 

IF (NLINE .LE. 5 .OR. NLINE .GE. MAXLINI GO TO 810 
IF ((NLINE+2+12 » .GT. MAXLINI 60 TO 810 
WRITE (NOT, 2050) 

NLINE - NLINE + 2 
GO TO 811 

810 CALL PAGEHD 

811 WRITE (NOT, 20011 
NLINE = NLINE + 12 


CALL PWNO 
CALL OUT 
CALL OUT 


(NUTl) 

(NUT1,A,KR*N) 

(NUT1,E,KR4N) 


CALL DCOMl (A,A,N,KR) 

CALCULATE DYNAMIC MATRIX = ( U) ♦( FLEX )♦ (UT*T) . STATEMENTS FROM 
SUBROUTINE BAETA MODIFIED BECAUSE LOWER (U) IS ZERO AND ONLY 
UPPER HALF OF DYNAMIC MATRIX IS USED IN SUBROUTINE EIGNl. 

DO 24 1 = 1 ,N 

DO 22 J=1,N 

S = ZERO 

DO 21 K=J,N 

SS = E(I,K)*A(J,K| 

21 S = S + SS 

22 W(J) = S 

DO 24 J=1,N 

24 E(I,J) = W(J) 

DO 28 J = 1»N 
DO 26 1=1, J 

S = ZERO 

DO 25 K=I,N 

SS = A( I,K)*E (K,J) 

25 S = S + SS 

26 W(I) = S 

DO 28 1 = 1, J 
28 E(I,J) = W(I) 

CALL INV4 (A,A,N,KR) 

CALL EIGNl (E,W2,A,-N,F0D,KR) 


CALCULATE W2. 

DO 29 1 = 1, N 

IF (W2(I) .LT. EPS) W2(I)=EPS 
29 W2(I) = l./W2(I) 


ALIGN THE CIRCULAR FREQUENCY SQUARED (W2) INTO INCREASING ORDER AND 
THE MODE SHAPES CORRESPONDINGLY. 

IF (N .EQ. 1) GO TO 40 
NMl = N“1 
DO 35 J=1 ,NM1 
W2MIN = W2(J) 

IMIN = J 
JPl = J+1 
DO 30 I=JP1,N 

IF (W2MIN .LE. W2(II) GO TO 30 
W2MIN = W2(I) 


A=MASS 

E=FLEX 

A=U 


E=OYNMAT 

A=U**-1 

W2=VAL 

A=PHI 


W2=W2 
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IMIN = I 
30 CONTINUE 

IF (IMIN .EQ. GO TO 35 
W2(IMIN) = W2(J) 

W2(J) = W2MIN 

DO 34 K=1,N 
AKJ = A(K,J) 

A(K,J» = A(K,IMINI 

34 A(K,IMIN) = AKJ 

35 CONTINUE 
C 

C MAKE THF FIRST ELEMENT OF EACH MODE SHAPE POSITIVE. 

40 00 45 J=1,N 

IF (A(1,J) .GE. O.I GO TO 45 
DO 42 1=1, N 
42 A(I,J) = ~A(I,J1 
45 CONTINUE 
C 

C CALCULATE (PHnT*(MASSl=MPHl ) ORTHOGONALITY CHECK. 

CALL OUT (NUTl ,A,KR*N) 

CALL RWND (NUTII 

CALL IN (NUT1,E,KR*N) 

CALL RTAEA ( E ,A,N,N,KR ,KR » 

XCFF = 0. 

lOFF = 1 

JOFF = 2 

DO 54 1 = 1, N 

DO 52 J = I,N 

IF (I ,E0. J) GO TO 52 

IF (ABS(XPFF» .GE. ABS(E(I,jni GO TO 52 
XOFF = E( I,J| 
lOFF = I 
JOFF = J 
52 CONTINUE 
54 CONTINUE 
NPL = N/10 

IF (iNPL^lO) .NE. N| NPL = NPL+1 
IF (MINI ,NE. 4HMINII GO TO 820 

IF (NLINE .LE. 5 .OR. NLINE .GE. MAXLIN) GO TO 820 
IF ((NLINE+2+14+NPLI oGT. MAXLINl GO TO 820 
WRITE (NOT, 20 50) 

NLINE = NLINE ♦ 2 
GO TO 821 

820 CALL PAGE HD 

821 WRITE (NOT, 2002) (JC,JC=1,10) 

WRITE (NOT, 2011) (E (I ,1 ),I=1,N) 

WRITE (NOT, 2012) XOFF, lOFF, JOFF 
NLINE = NLINE + 14 ♦ NPL 

C 

C CALCULATE (PHI)T*(MASS)*(FLEX)4(MASS)*(PHI ) ORTHOGONALITY CHECK. 
CALL RWND (NUTl) 

CALL IN (NUTl ,E,KR»N) 

CALL MULTA ( E , A , N,N,N, KR ,KR ) 

CALL IN (NUT1,A,KR*N) 

CALL BTABA ( A,E,N,N,KR,KR) 


E=MASS 

E=PMP 


E=MASS 

E=MP 

A=FLEX 

A=PTMEMP 
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DO 64 1=1, N 
W(I) = 0. 

DO 62 J=1,N 

IF (I ,FQ. J) GO TO 62 

IF (APS(A(I,J)| .GT. ABS(W(im Wm=A(IfJ} 

62 CONTINUE 
64 CONTINUE 

IF (MINI .NE. 4HMINI) GO TO 830 

IF (NLINF .LE. 5 .OR. NLINE .GF. MAXLIN) GO TO 830 
IF ((NLINE+2+70+3*NPU .GT. MAXLINI GO TO 830 
WRITE (N0T,2050» 

NLINE = NllNt *- 2 
GO TO 831 

830 CALL PAGFHD 

831 WRITE (N0T,2002) (JC,JC=l,10) 

DO 66 1=1 ,N 

66 FREOII) = 1./W2II) 

WRITE (NOT, 2020) (ERE Q( I ) ,I =1 ,N ) 

NLINE = NLINE + & + NPL 
DO 68 1 = 1, N 

68 Ad, I) = ABS(A(I,I)-FREQ(in*100./FREQm 
WRITE (M0T,2021) CA(I,I), 1=1, N) 

WRITE (NOT, 2022) (W(I), I=1,N) 

NLINE = NLINE + 12 +2*NPL 
C 

CALL IN (NUT1,A,KR*N) A=PHI 

DO 72 I=1,N 

W(I) = SORT (ABS(W2(I))) 

72 FREQ(I)= .15915494 * W(I) 

C 

RETURN 

END 
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J 


C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

r 


C 

C 

C 

c 

c 

c 

c 

c 

L 


SUBROUTINE MODEIX ( A» S»W2 ,N«CTW2*KR I 
DIMENSION A(KR,1), S(KR,1), W2<1» 

DOUBLE PRECISION DM,DS 

CALCULATE MODE SHAPES <PHI I AND NATURAL FREOUENCIES OF 
(AI»*-l(SHt»HII = (PHI)(-W2-| USING METHOD OF JACOBI. 

MODIFICATION OF SUBROUTINE MODEl TO ALLOW NON-POSITIVE DEFINITE MASS 
MATRIX, REMOVE ORTHOGONALITY CHECKS, AND USE W2 CONVERGENCE TOLERANCE. 
THE MASS (Al MATRIX SHOULD BE REAL, SYMMETRIC. 

THE STIF CS) MATRIX SHOULD BE REAL, SYMMETRIC. 

UPPER HALF OF MATRIX (A» IS USED TO CALCULATE MODE SHAPES AND 
FREOUENCIES. FULL MATRIX (SI IS USED. 

INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

CALLS FORMA SUBROUTINES BTABA2,EIGN1A, INVAtlZZBOMBI. 

THE MAXIMUM SIZE IS 

N = 500 (BASED ON 8TABA2I . 

DEVELOPED BY RL WOHLEN. JANUARY 1972. 

LAST REVISION BY RL WOHLEN. MARCH 1976. 

SUBROUTINE ARGUMENTS 

A = INPUT MASS MATRIX. SIZE(N,N). *DESTROYED* 

= OUTPUT MODE SHAPES. SIZE(N,N|. 

S = INPUT STIFFNESS MATRIX. SIZE(N,N). ♦DESTROYED* 

W2 = OUTPUT VECTOR OF EIGENVALUES (OMEGA SQUARED). SIZE(N). 

N = INPUT SIZE OF MATRICES A,S AND VECTOR W2. 

CTW2 = INPUT CONVERGENCE TOLERANCE ON W2. IF CTM2 .LE. C., 

10A»-6 WILL BE USED. CONVERGENCE ASSUMED 
IF W2 .LT. CTW2 OR IF THE W2 RATIO OF 
(CUR RENT-PRECEDING) /CUR RENT .LT. CTW2. 

KR = INPUT ROW DIMENSION OF A,S IN CALLING PROGRAM. 


DECOMPOSE MASS MATRIX (A) = (U )»*T ♦ (U). 

MODIFICATION OF SUBROUTINE DCOMl TO USE SQRT(A6S( A(I ,11) ) AND A = Z. 
A(l,l) = SC<RT(ABS(A(1,1)») 

IF (N .EQ. 1) GO TO 28 
DO 5 J=2,N 

5 A(1,J) = A(1,J)/A(1,1) 

DO 18 1=2,N 
IMl = I-l 
IPl = I+l 
OS = A(T,I) 

DO 10 K=1,IM1 
DM = A(K,I)^^2 
10 DS = ns - DM 
A (1,1) = DS 

A(I,I) = SQRT(ABS(A(I,I))) 

IF (I .FQ. N) GO TO 20 
DO 18 J=1P1,N 
OS = A(I,J) 

DO 15 K=1,IM1 
DM = A(K,I)*A(K,J) 

15 DS = OS - DM 
A(I,J) = DS 

18 A(I,J) = An,J)/A(I,I) 

20 DO 25 1=2 ,N 
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IMl = I«1 
DO 25 

25 A(I,J} = 0.0 A=U 

C 

28 CALL INV4 (AtA,NtKR» A=U**-1 

CALL BTABA2 <StA,N,KR) S=0YNMAT| 

CALL EIGNIA ( S»W2t A,-N»CTW2 tKR) W2=W2 

C A-PHI 


C ALIGN THE CIRCULAR FREQUENCY SQUARED (H2J INTO INCREASING ORDER AND 
C THE MODE SHAPES CORRESPONDINGLY. 

IF (N .EO. 1) RETURN 
NMl = N-1 
DO 35 J=ltNMl 
W2MIN = W2IJ) 

IMIN = J 
JPl = J+I 
DO 30 I=JPI»N 

IF (W2MIN .LE. W2m) GO TO 30 
W2MIN = W2(I) 

IMIN = I 
30 CONTINUE 

IF (IMIN .EO. J) GO TO 35 
W2(IMIN) = W2(J) 

W2(J) = W2MIN 

DO 34 K=1,N 
AKJ = A(K,»J) 

A(K,J) = A(K,IMIN) 

34 A(K,IMIN) = AKJ 

35 CONTINUE 


♦ 


C 


RETURN 

END 
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C 

C 

C 

C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 


SUBROUTINE MULT f A »B tZ tNRA «NRB«NCB tKRA *KRB ) 
DIMENSION A(KRAtl)* B(KRB»1)« Z(KRA«1) 
DOUBLE PRECISION S,SS,ZERO 
DATA ZERO/O.D/ 


MATRIX MULTIPLICATION. A ♦ B = Z. 

INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 
DEVELOPED BY R L WOHLEN. FEBRUARY 1965. 

LAST REVISION BY RL WOHLEN. MARCH 1976. 


A 

B 

Z 

NRA 

NRB 

NCB 

KRA 

KRB 


SUBROUTINE ARGUMENTS 
= INPUT MATRIX. SIZE INRAt NRB ) . 
s INPUT MATRIX. SIZECNRB*NCBI. 

= OUTPUT RESULT MATRIX. SIZE (NRA, NCB I . 

= INPUT NUMBER OF ROWS OF MATRICES A,Z. 

= INPUT NUMBER OF ROWS OF MATRIX B, COLS OF MATRIX A. 

= INPUT NUMBER OF COLS OF MATRICES B,Z. 

= INPUT ROW DIMENSION OF A,Z IN CALLING PROGRAM. 

= INPUT ROW DIMENSION OF B IN CALLING PROGRAM. 


DO 20 1 = 1, NRA 
DO 20 J=1,NCB 
S = ZERO 
DO 10 K=1,NRP 
SS = A(I,K)*B(K,J) 
10 S = s + ss 
20 Z(I,J) = S 
RETURN 
END 
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SUPf^OariNE MULTA CAZtB,NRA»NRBvNCB*KAZ,KB» 

DIMENSION AZ(KAZtl). B(KB,1) 

COMMON / LWRKVl / W(500) 

DOUBLE PRECISION SfSStZERO 
DATA ZERO/O.D/ 

C 

C MATRIX MULTIPLICATION. A * B = Z. 

C USES TWO WORK SPACES. RESULT «Z) IS PLACED IN A. 

C AZ MUST PE DIMENSIONED LARGE ENOUGH IN MAIN PROGRAM TO CONTAIN THE 
C LARGER OF A OR Z. 

C INNER PRODUCT SUMS APE PERFORMED IN DOUBLE PRECISION. 

C CALLS FORMA SUBROUTINE ZZBOMB. 

C THE MAXIMUM SIZE IS 
C NRB = 500 

C DEVELOPED BY C S BODLEY. JANUARY 1965. 

C LAST REVISION BY RL WOHLEN. MARCH 1976. 

C 

C SUBROUTINE ARGUMENTS 

C AZ = INPUT MATRIX. SIZE<NRA»NRB) . 

C = Ol'tP'JT RESULT MATRIX. SI ZE (NRA*NCB ) . 

C B = INPUT MATRIX. S I2E ( NRB» NCB ) 

C NBA = INPUT NUMBER OF ROWS OF MATRICES AtZ. 

C NRB = INPUT number OF ROWS OF MATRIX B» COLS OF MATRIX A. MAX=500. 

C NCB = INPUT NUMBER OF COLS OF MATRICES B*Z. 

C KAZ - INPUT ROW DIMENSION OF AZ IN CALLING PROGRAM. 

C KB = INPUT ROW DIMENSION OF B IN CALLING PROGRAM. 

NERROR EXPLANATION 
1 = MORE THAN 500 ROWS IN MATRIX B. 

NERR0R=1 

IF (NRB .GT. 500J GO TO 999 
C 

DO 40 1=1 »NRA 
DO 20 K=1,NRB 
20 W(K) = AZ(I,K) 

DO 40 J=1»NCB 
S = ZERO 
DO 30 K = 1 ,NRB 
SS = W(K)^R(K,J) 

30 S = S + SS 
40 A2(I,J) = S 
RETURN 
C 

999 CALL ZZBOMB (6HMULTA , NERROR) 

END 
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SUBROUTINE MULTB < A ,BZ,NRA* WBtNCBvKA.KBZ) 

DIMENSION A(KA«UtBZ(KBZtl) 

COMMON /LWRKVl/ W(500l 
DOUBLE PRECISION S,SSfZERO 
DATA ZERO/0.0/ 

C 

C MATRIX MULTIPLICATION. A ♦ B = Z. 

C USES TWO WORK SPACES. RESULT C2I IS PLACED IN B. 

C BZ MUST RE DIMENSIONED LARGE ENOUGH IN MAIN PROGRAM TO CONTAIN THE 
C LARGER OF B OR Z. 

C INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

C CALLS PORMA SUBROUTINE ZZBOMB. 

C THE MAXIMUM SIZE IS 
C NRB = 500 

C DEVELOPED BY CARL BODLEY. JANUARY 1965. 

C LAST REVISION BY RL WOHLEN. MARCH 1976. 

C 

C SUBROUTINE ARGUMENTS 

C A = INPUT MATRIX. SIZE(NPA.NRB) . 

C BZ = INPUT MATRIX. S IZE ( NRB.NCBI . 

C = OUTPUT RESULT MATRIX. SI ZE CNRA,NCB ) . 

C NRA = INPUT NUMBER OF ROWS OF MATRICES A,Z. 

C NRB = INPUT NUMBER OF ROWS OF MATRIX Bt COLS OF MATRIX A. MAX=500. 

C NCB = INPUT NUMBER OF COLS OF MATRICES B,Z. 

C KA = INPUT ROW DIMENSION OF A IN CALLING PROGRAM. 

;C KBZ = INPUT ROW DIMENSION OF BZ IN CALLING PROGRAM. 

NERROR EXPLANATION 
1 = SIZE LIMITATION EXCEEDED. 

NERR0R=1 

IF (NRB.GT.500 .OR. NRA.GT.KBZ .OR. NRB.GT.KBZ] GO TO 999 
C 

DO 40 J=1,NCB 
DO ?0 K=1,NRB 
20 W(K) = B2(K,J) 

DO 40 1=1, NRA 
S = ZERO 
00 30 K=1,NPB 
SS = A( I,KJ*W(K» 

30 S = S ♦ SS 
40 PZ(I,J» = S 
RETURf. 

C 

999 CALL ZZBOMB {6HMULTB ,NERROR) 

END 
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FUNCTION NAME INAMEIN.NUMIN ) 

DIMENSION FMTU5) tFMT2«3) 

DATA FMT1/2H(A,1H ,2H,I,1H ,1HI/ 

DATA FMT2/2H(I*1H flHl/ 

FUNCTION TO MERGE NAMEIN AND NUMIN INT'^ ONE VARIABLE (NAME I WHICH MAY 
BE USED AS AN A6 OUTPUT NAME IN ROUTINES SUCH AS FORMA SUBROUTINES 
WRITE, WTAPE, CKSTFl, PLOTl, ETC. (SEE EXAMPLES BELOW. I 
NOTE... IF THE SUM OF THE NON-BLANK CHARACTERS IN NAMEIN-MERGED-WITH- 
NUMIN EXCEEDS 6, THE RIGHT MOST HARACTERS OF NAMEIN WILL BE 
DROPPED TO MAKE ROOM FOR NUMIN. (THE NUMBER ZERO IS NOT 
CONSIDERED A BLANK.) 

NOTE... THE INTRINSIC FUNCTION FLO IS USED. IT IS NOT 
AVAILABLE ON ALL COMPUTERS. 

DEVELOPED BY RF ■ -^UDA APRIL 01,1972 

LAST REVISION BY JOHN ADMIRE ♦NASA* JAN 1974. 

FUNCTION ARGUMENTS 

NAMEIN = INPUT ALPHANUMERIC NAME. MUST BE SUPPLIED IN CALLING 

PROGRAM AS A 6H , OR 8Y A VARIABLE DEFINED 

WITH AN A6 FORMAT. 

NUMIN = INPUT A POSITIVE INTEGER NUMBER TO BE MERGED INTO NAMEIN. 
NAME = OUTPUT ALPHANUMERIC NAME WHICH MAY BE USED IN AN A6 

OUTPUT FORMAT. 

EXAMPLES, 

CALu WRITE (A,NR,NC,NAME(3HABC,69),KAI 

WOULD YIELD AN OUTPUT NAME ABC69 (LEFT JUSTIFIED). 

CALL write (A,NA,NA,NAME(1HK,NA),KA) , WHERE NA = 124, 

WOULD YIELD AN OUTPUT NAME K124 (LEFT JUSTIFIED). 

DO 5 1=1, N 

5 CALL WRITE { A ,NA ,NA ,N AME( AHSTIF, I ) ,KA ) 

WOULD YIELD OUTPUT NAMES STIFl ,STIF2 ,STIF3 ,... 

4000 FORMAT (ID 

IF (NUMIN.LT.O .OR. NUMIN .GT. 999999 ) RETURN 

FIND NUMBER OF DIGITS IN NUMIN. 

DO 10 ND=1,6 

IF (NUMTN.lt. 10**ND) GO TO 20 
10 CONTINUE 

20 IF (N0.E0.6) GO TO 50 

FIND NUMBER OF LETTERS IN NAMEIN. 

DO 30 1=1,6 
NL = 7-1 
N1 = (NL-1)*6 

IF (FL0(N1, 6, NAMEIN) .NE. 6H((((( ) GO TO 40 
30 CONTINUE 
GO TO 50 

40 IE (NL+ND.GT.6) NL = 6-ND 
MERGE NAMEIN AND NUMIN INTO NAME. 



NTOT = NL+ND 
ENCODE (4000tEMTll2)» NL 
ENCODE C4000,FMT1 I4)> ND 
ENCODE (FMT1,NAMEI NAMEINtNUMIN 
RETURN 


50 ENCODE l4000tFMT2C2n NO 
ENCODE CFMT2,NAME» NUMIN 
RETURN 
END 
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SUBROUTINE ONES (ZtNR«NCtKR) 

DIMENSION ZiKRfll 

C GENERATE A MATRIX OF ONES. 

C CODED BY RL WOHLEN. FEB 1965. 

C 

C SUBROUTINE ARGUMENTS 

C Z = OUTPUT MATRIX GENERATED. SIZECNR,NC). 

C NR = INPUT NUMBER OF ROWS IN MATRIX Z. 

C NC = INPUT NUMBER OF COLS IN MATRIX Z. 

t KR = INPUT ROW DIMENSION OF MATRIX 2 IN CALLING PROGRAM. 

C 

DO 10 1=1, NR 
DO 10 J=1,NC 
10 Z(I,J) = 1.0 
RETURN 
END 
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SUBROUTINE ONRBM fRBM*AMASSv N «NRBMt K) 

DIMENSION RBM(K,l),AMASSfK»ll«EVALf6)tEVEC(6t6l»B(6*6l 

ORTHONORMALIZES the rigid BODY MCOEISI. 

NORMALIZATION IS R BM ITRANSPOSE l^'AMASS^RBM = UNITY. 

CALLS FORMA SUBROUTINES BTAB,EIGNl,MULTA*PAGEHD,2ZBOMB. 

THE MAXIMUM SIZES ARE 

N = 250 (BASED ON BTABI 

NRBM - 6 

DEVELOPED BY CS BODLEY AND RF HRUOA. DECEMBER 1965. 

LAST REVISION BY WA BENFIELD. MARCH l'»76. 

SUBROUTINE ARGUMENTS 

RBM = INPUT ANY RIGID BODY MOOES. SIZEC N,NRBM I . »DESTROYED^ 

= OUTPUT CRTHONORMAL RIGID BODY MODES. SIZE (N, NRBM I . 

AMASS = INPUT CORRESPONDING MASS MATRIX. SIZE(N,N}. 

N = INPUT SIZE OF MASS MATRIX, NUMBER OF ROWS IN RBM. MAX=250. 

NRBM = INPUT NUMBER OF RIGID BODY MODES, COLUMNS IN RBM. MAX=6. 

K = INPUT ROW DIMENSION SIZE OF RBM AND AMASS IN CALLING PROGRAM. 

NERROR EXPLANATION 
1 = MORE THAN 6 RIGID BODY MODES. 


NERR0R=1 

IF (NRBM .GT. 6) GO TO 999 
C 

DO 20 J=1,NRBM 
RMAX = ABS(RBM(l,jn 
DP 10 1=2 ,N 

10 IF( ABS(PBM(I,J») .GT. RMAX ) RMAX = ABS(RBM( I, J) } 

DO 20 1=1, N 

20 RBM(I,J) = RBM(I, JI/RMAX 
C 

CALL BTAB (AMASS, RBM, B , N ,NRBM, K,6l 
CALL EIGNl (B ,EVAL,EVEC, NRBM,1.E-10, 61 
00 30 J=I,NRBM 
DO 30 1=1, NRBM 

30 EVEC(I,JI = EVEC(I,J)/SORT(EVAL(JM 

CALL MULTA (RBM,EVEC, N ,NRBM,NRBM, K,6l 
RETURN 
C 

999 CALL ZZBCMB (6H0NRBM ,NERRORI 
END 
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SUBROUTINE OROALP (IMAT»NR,NCtNCAL«IWMAT»KR*KCW} 
DIMENSION IMAT(KR,n,IWMAT|KR •1)«IVA(371 
COMMON / LWRKVl / IVflBOl 


DATA 

IVA/6H** 

••• ,6H* 


••0,6H»« 


••2,6H*« 

•••3,6H«» 



♦ 

6H*» 

•• •5,6H* 




••8,6H*« 

•••9,6H* • 


••A, 


6H»* 

•••B,6H» 


••C,6H«« 

•••D,6H* •• 


•••F,6H»* 


••G, 

♦ 


•• •H,6H» 


••I,6H*« 

••• J,6H» •• 

••K,6H»" 

•••L,6H«» 


^•M, 



•••N,6H« 


•■0,6H** 

•••P,6H»»« 


•••R,6H«* 


••s. 

* 

6H** 

•••T,6H**' 

••U,6H»« 

•••V,6H*«* 

••W,6H»« 

••■X,6H*« 


••Y, 

♦ 


•••2/ 









C 

C THIS ROUTINE REORDERS THE ROWS OF A MATRIX ALPHABETICALLY ACCORDING 
C TO THE FIRST NCAL COLUMNS OF THE MATRIX. EACH ELEMENT IN THE FIRST 
C NCAL COLUMNS IS ASSUMED TO CONTAIN SIX CHARACTERS. THE CHARACTERS 
C ARE RESTRICTED TO LETTERS, NUMBERS AND SPACES. 

C 

C NOTE< IF THE FIRST NCAL COLUMNS ARE THE SAME FOR TWO ROWS THEIR 
C ORDER MAY BE REVERSED AFTER CALLING THIS ROUTINE. 

C 

C SUBROUTINE ARGUMENTS 

C IMAT - INPUT MATRIX TO BE REORDEREO 

C NR - INPUT NUMBER OF ROWS IN IMAY 

C NC - INPUT NUMBERS OF COLUMNS IN IMAT 

C NCAL - INPUT NUMBER OF COLUMNS IN IMAT TO BE USED FOR REORDERING 
C MAXIMUM VALUE OF NCAL=30. 

C IWMAT - MATRIX WORKING SPACE (KR BY KCWl 

KR - INPUT ROW DIMENSION IN CALLING PROGRAM FOR IMAT AND IWMAT 

C KCW - INPUT COLUMN DIMENSION IN CALLING PROGRAM FOR IWMAT 

C KCW .GE. NCAL 

C 

C CODED BY JCHN ACMIPE *NASA* DEC 1974. 

C 

C 1108 SYSTEM ROUTINE FLD IS CALLED. 

C FORMA ROUTINE 2ZBOMB IS CALLED. 

C 

NCW=NCAL*6 

NERROR=l 

IF(NCW .GT. KCW) GO TO 999 
NERROR=2 

IFINCW .GT. 180) GO TO 999 

DO 20 1=1, NR 

DO 20 J=! ,NCAL 

DO 20 L=l,6 

JJ=(J-1 )*6+L 

II=IABS(< L-l)*6) 

IWMAT) I , J J )=FLO (11,6, IMAK I ,J ) ) 

DO 10 K=l,37 

IFdWMATC I,JJ) .NE, IVA(K)| GO TO 10 
IWMATCI, JJ)=K 
GO TO 20 
10 CONTINUE 
NERR0P=3 
GO TO 999 
20 CONTINUE 
NRK=NR-1 
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DO 100 I:=1,NRM 
00 30 L=1»NCW 
30 IV(LI=IWMAT«I,LJ 
II=I 
IP=I+1 

DO 70 J=IP,NR 
00 40 L=ltNCW 

IF(IWMAT(J,LI-IV<LI 150,40*70 
40 CONTINUE 
GO TO 70 
50 DO 60 L=1,NCW 
60 IV(L)=IWMAT<J,LI 
II=J 

70 CONTINUE 

IFdl .EO. i; GO TO 100 
DO 80 L=1,NC 
IA=IMATCIIiLl 
IMAT(II,L)=1MATI1,LI 
80 IMAT(I,LI=IA 
DO 90 L=1,NCW 
IA=IWMAT(II,L) 
IWMAT(II,L)=IWMAT(1,LI 
90 IWMATf I,LI=^IA 
100 CONTINUE 
R ETURN 

999 CALL ZZB0MB(6H0RDALP,NERR0R» 
END 
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SUBROUTINE OUT INTAPE, A,NI 
DIMENSION A(l) 

WRITE DATA FROM CORE SPACE A OUT TO NTAPE. 

CODED BY RL WOHLEN. MARCH 1976. 

SUBROUTINE ARGUMENTS I ALL INPUT) 

NTAPF = NUMBER OF TAPE. I EG 10). 

A = DATA TO BE WRITTEN ON NTAPE. 

N = NUMBER OF WORDS OF DATA TO BE WRITTEN ON NTAPE. 


WRITE (NTAPE) (A(I),I=1,N) 

RETURN 

END 
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SUBROUTINE PA ( P, A ,Z tNR,NC tKRA,KRZ» 

DIMENSION A(KRA,l),Z(KRZ,n 

PA PERFORMS THE OPERATION (Z)=P*IA) 

WHERE (Z) AND (A» ARE MATRICES AND P IS A SCALAR. 

PA CAN ALSO PERFORM THE OPERATION 
(A)sP*(a) by call PAfPtAtAt — ETC — ) 

IF NR IS NEGATIVE AND ABS(NR) IS EOUAL TO NC 

A SQUARE, SYMMETRIC (Z» IS COMPUTED USING THE UPPER HALF OF (AJ. 

FORMA SUBROUTINE ZZBOMB IS CALLED . 

CODED BY JOHN ADMIRE *NASA» JULY 1972 . 

LAST REVISION BY RL WOHLEN. APRIL 1976. 

ARGUMENTS 

P - INPUT SCALAR P 

A - INPUT MATRIX <AI SIZECNR BY NC) 

Z “ OUTPUT MATRIX (Z) SIZE (NR BY NC) 

NR - INPUT ABSfNR) IS THE NUMBER OF ROWS IN (A) 

NC “ INPUT NUMBER OF COLUMNS IN (A) 

KRA - INPUT ROW DIMENSION OF (A) IN CALLING PROGRAM 

KRZ - INPUT ROW DIMENSION OF (Z) IN CALLING PROGRAM 

NERROR EXPLANATIONS 

1 = SIZE EXCEEDS DIMENSIONS. 

2 = NON-SQUARE (Z) WANTED. 

N=IABS(NR ) 

NERROR = 1 

IF(N .GT. KRA .OR. N .GT. KRZ) GO TO 999 
IF(NR .LT. 0) GO TO AO 
C=ABS(P-1 .) 

IF(C .GT. l.OE-7) GO TO 20 
DO 10 1 = 1, NR 
DO 10 J=1,NC 
10 Z(I,J)=A( 1,J) 

RETURN 

20 DC 30 1 = 1, NR 
DO 30 J=1,NC 
30 Z(I,J)=P»A(I,J) 

RETURN 

40 NERROR = 2 

IF(N .NE. NC ) GO TO 999 
C=ABSCP-I .) 

IF(C .GT. l.OE-7) GO TO 60 
DO 50 1 = 1 ,N 
DO 50 J=I,N 
Z ( I,J)=A( I, J) 

50 Z(J,1) = Z(I,J) 

RETURN 

60 00 70 1=1 ,N 
DO 70 J=I,N 
Z{I,J)=P’f'A(l,J) 

70 Z(Jtl) = Z<1,J) 

RETURN 



999 CALL Z2B0MBC6HPA ,NERRORI 
END 
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SUBROUTINE PAGEHD 

COMMON /L START/ I RUNNO,DATE .NPAGE ,UNAME (3 » ,TITLE1 (12 1 ,TITLE2 ( 12 I 
COMMON /LLINE / NLINE,MAXLINtMINl 
DATA NIT, NOT/5, 6/ 

BRINGS UP NEW PAGE AND PUTS HEADING AT TOP, 

INCREASES PAGE NUMBER BY ONE AND SETS LINE NUMBER EQUAL TO FIVE. 

INTERNAL VARIABLES 
IRUNNO = RUN NUMBER (A6 FORMAT! 

DATE = DATE (A6 FORMAT) 

NPAGE = PAGE NUMBER 

UNAME = USERS NAME (3A6 FORMAT) 

TITLEl . = FIRST TITLE ( 12A6 FORMAT) 

TITLE2 = SECOND TITLE ( 12A6 FORMAT) 

NLINE = LINE NUMBER 

MAXLIN = MAXIMUM NUMBER OF LINES PER PAGE 
MINI = PRINT OPTION (AA FORMAT) 

MODIFIED AUG 1973 BY JOHN ADMIRE *NASA* 

2001 F0RMAT(9H1RUN NO. A6,32X,5HDATE A6,12H CPU TIME=I4, 

♦ AH SEC,32X,9HPAGE NO. IA,/55X7HRUN BY 3A6//10X, 

♦ 12A6/10X,12A6) 

C 

CALL CPUTIM(ISEC) 

ISEC=ISEC/1 000000 

NPAGE=NPAGE+1 

NLINE=5 

WRITE (N0T,2001) IRUNNO, DATE, ISEC, NPAGE , UNAME , TITLEl, TITLE2 

RETURN 

END 
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] SUBROUTINE PAQB (P , A,Q » B ,Z fNR, NC,KR A ,KRB ,KR2 I 

1 DIMENSION A(KRA«I]I,B(KRB»1) «Z(KRZtl) 

C 

C PAOB PEPEOPMS THE OPERATION ( Z)=P*( A) H|*(B J 

C WHERE (A»,<BJ AND (Zl ARE MATRICES AND 

C P AND Q APE SCALARS . 

C PAQB CAN ALSO PERFORM THE OPERATIONS 

C (AI=P*(A)+C*(B) BY CALL PAOB(P,A«OtB«A» — ETC — I 

C 4P»=P*(A»+0*IB» BY CALL PAOBCP#A*0*B.B, — ETC — ) 

C (ZI=P*(A)+0*( Al BY CALL PAQ6(P,A»0»A»Z« — ETC — » 

C (AI=P*-IAI+C*CA» BY CALL PAQB(P,A»0»A, A, — ETC — I 

t 

C IF NR IS NEGATIVE AND ABS(NR) IS EQUAL TO NC 

C A SQUARE, SYMMETRIC (Z) IS COMPUTED USING THE UPPER HALF OF (A},(B). 

C 

C FORMA SUBROUTINE ZZBOMB IS CALLED . 

C CODED BY JOHN ADMIRE *NASA* JULY 1972 . 

C LAST REVISION BY RL WCHLEN^ APRIL 1976, 

C 

C ARGUMENTS 

C P - INPUT SCALAR P 

C A “ INPUT MATRIX (A) SIZE(NR BY NCI 

C Q - INPUT SCALAR Q 

C B - INPUT MATRIX CB| S1ZE(NR BY NC) 

C Z - OUTPUT MATRIX (21 SIZE (NR BY NC) 

C NR - INPUT APS (NR) IS IFF NUMBER ROWS IN (A), (B ) AND (2) 

NC - INPUT NC IS THE NUMBER OF COLUMNS IN (A), (B) AND (Z) 

C KRA - INPUT ROW DIMENSION OF (A) IN CALLING PROGRAM 

C KRB - INPUT ROW DIMENSION OF (B) IN CALLING PROGRAM 

C KRZ - INPUT ROW DIMENSION OF (Z) IN CALLING PROGRAM 

C 

C NFRROR EXPLANATIONS 

C 1 = SIZE EXCEEDS DIMENSIONS. 

C 2 = NON-SQUARE (Z) WANTED. 

C 3 = NON-SQUARE (Z) WANTED. 

c 

N=IABS(NR ) 

NERROR = 1 

IF(N .GT. KRA .OR. N .GT. KRB .OR. N .GT. KRZ) GO TO 999 
CP=ABS(P-1. ) 

CQ=APS(C-1.) 

IF (CP .GT. I.OE-7 .OR. CQ .GT. l.OE-7) GO TO 40 
IF (NR .LT. 0) GO TO 20 
DO 10 1 = 1 ,NP 
DO 10 J=1,NC 
10 Z(I,JI=A( I,J)+6(I,J) 

RETURN 

20 NERROR = 2 

IF(N .NE. NC) GO TO 999 
DO 30 1=1, N 
00 30 J=I,N 

Z(1,J) = A(I,J) + B(I,J) 

' 30 Z(J,I) = Z(I,J) 

RETURN 

40 IFINR .LT. 0) GO TO 60 
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00 50 1=1 »NR 
DO 50 J=1,NC 
50 Z(ItJ)=P*A(If 
RETURN 

60 NERROR = 3 

IF(N .NE. NCI GO TO 999 
DO 70 1=1, N 
DO 70 J=I,N 

2(I,J)=P*An,J)+C*B(I,J) 

70 Z(J,I) = Z(1,J) 

RETURN 

999 CALL ZZB0MD(6HPAQB .NERROR) 

END 
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SUbROUTINE PLOTl fXVEC,YMAT ,NR,NC,1XNAME*IYNAME,ITITLE *IFCURV,K I 
COMMON /LSTART/ I RUNNO,DATE ,NPAGE ,UNAME (3 ) »TITLE1 (12 1 1 TITLE2 < 12 ) 
DIMENSION XVECIl ),YMAT(K,1),1YNAME(1I»ITITLE(1),ITITL( 121 
DATA NIT,NOT/5t6/ 

EQUIVALENCE (IDATE.DATE) 

PLOTS FROM 1 TO 3 VECTORS PER FRAME. X-AXIS AND Y-AXIS ARE LINEAR. 

CALLS FORMA SUBROUTINES PLOTSS, 22BOMB. 

THE MAXIMUM SI2E IS 
NC=3 

COOED BY RF HRUOA 01, JULY 1968 
MODIFIED FOR CONTRACT NAS8-25922, MAY 1971, 

NOTE... FOR TRAN STATEMENT -CALL IDENT (11- MUST BE IN LOGIC OF MAIN 

PROGRAM PRIOR TO CALLING THIS ROUTINE- IT MUST BE EXECUTED ONLY 
ONCE (INDEPENDENTLY OF NUMBER OF TIMES MAIN BODY OF THE PROGRAM 
IS EXECUTED). 

FORTRAN STATEMENT -CALL ENDJOB- MUST BE IN LOGIC OF MAIN PROGRAM 
SUBSEQUENT TO CALLING THIS ROUTINE, IT MUST BE EXECUTED ONLY ONCE. 

SUBROUTINE ARGUMENTS (ALL INPU"*^) 

XVEC = VECTOR OF X-AXIS COORDINATES. SI2E(NR|. 

YMAT = SET OF NC VECTORS TO BE PLOTTED SIMULTANEOUSLY. S12E(NR,NCI. 

NR = NO. OF ROWS IN YMAT (AND XVEC) 

NC = NO. OF COLS (OR VECTORS) IN YMAT 

IXNAME = AN A6 NAME FOR X-AXIS 

lYNAME = A 12A6 NAME FOR Y-AXIS 

(CAN BE READ IN MAIN PROGRAM WITH A FORMAT (12A6)) 

ITITLE = A 6A6 DEFINED IN THE CALLING PROGRAM WHICH WILL BE 

ASSEMBLED WITH IRUNNO AND DATE TO FORM TITLE. TITLE WILL 
APPEAR AT BOTTOM OF PLOT SHEET. 

IFCURV = 1 IF CONNECTED CURVE PLOT IS DESIRED 
= 0 IF DOT PLOT IS DESIRED 
K = ROW DIMENSION SI2E OF YMAT IN MAIN PROGRAM 

NEPROR EXPLANATIONS 

1 = MORE THAN 3 COLUMNS IN (YMAT). 

2 = IFCURV IS NOT 0 OR 1 . 


CHECK ON NO, OF VECTORS 
IF (NC.GT.3) GO TO 999 


NERR0R=1 


/ 

C 


FORM TITLE FROM ITITLE AND COMMON. 
ITITLd ) = IXNAME 
ITITL(?) = 6H 
ITITL(3) = IRUNNO 
ITITL(A) = 6H 
ITITL(5) = IDATE 
ITITK6) = 6H 
DO 5 1=1,6 

S ITITL(I+6) = ITITLE(I) 
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FIND MAX. AND MIN. OF YMAT t XVEC 
YMAX=iYMAT(I,l » 

YMIN=YMAT(l,l) 

XMAX = XVFC(l) 

XMIN = XVEC(l) 

DO 10 1 = 1, NR 

IF (XVEC (I) .GT. XMAX) XMAX = XVEC Cl) 

IF (XVECCII .LT. XMIN) XMIN = XVECCI) 

DO 10 J=1,NC 

IF(YMAT(I,J) .GT. YMAX) YMAX=YMAT C I * J ) 

10 if(ymat(i,j) .it. YMIN) YMIN=YMATC1»J) 

C FIND TOP AND BOTTOM VALUES FOR PLOT FRAME CYT AND YB ) 

CALL PLOTSS C YMAX , YMIN, YT,YB) 

C 

NP=0 

IF (IFCURV .EO. 0) NP=+NR 
IF (IFCURV .EO. 1) NP=-NR 
IFdFCURV .EQ. 0) JI=AO 
IFdFCURV .EQ. 1) JI=6l 

NERR0R=2 

IF (NP .EO. 0) GO TO 999 
NFWGRD = -1 
DO 20 1=1 ,NC 
IF (I .GT. 1) NEWGRD=0 

20 CALL 0UIK3L (NEWGRD, XMIN, XMAX, YB,YT,JI,ITITL,IYNAME,NP, XVEC, 

* YMATCl,!)) 

RETURN 

999 CALL ZZBOMB (6HPL0T1 ,NERROR) 

END 
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SUBROUTINE PL0T2 (XVECtYMAT,NR,NC»IXNAMF.IYNAHE,ITITLE,IPLD1. 

♦ YTOP,YBOT,XLEFTtXRIGHT,KR ) 

COMMON /L START/ IRUNNO,DATE tNPAGF jUNAME <3 ),TITLE1 112 ) »TITLE2 i 12 ) 
DIMENSION XVECn J ,YMAT( KR ,1 ) , ITITLE (11* ITITL( 12)* INC (10) 

DIMENSION lYNAME (1) 

DATA NIT,N0T/5*6/ 

DATA INO / 2H 1*2H 2,2H 3*2H 4*2H 5*2H 6*2M 7,2H 8*2H 9*2H10 / 
EQUIVALEHCE (DATE*IDATE) 

SULROUTINE PRODUCES LOG-LOG* SEMILOG-LINEAR, LINEAR-SEMILOG PLOTS. 

WILL PLOT UP TO 10 CURVES PER GRID. ALL CURVES WILL BE PLOTTED 
VERSUS XVEC AND WILL BE PLOTTED WITH THE SAME Y AXIS SCALE. 

NOTE. ..FORTRAN STATEMENT -CALL IDENT U *- MUST BE IN LOGIC OF MAIN 

PROGRAM PRIOR TO CALLING THIS ROUTINE. IT MUST BE EXECUTED ONLY 
ONCE (INDEPENDENTLY OF NUMBER OF TIMES MAIN PROGRAM IS 
EXECUTED) . 

FORTRAN STATEMENT -CALL ENDJOB- MUST BE IN LOGIC OF MAIN PROGRAM 
SUBSEQUENT TO CALLING THIS ROUTINE. IT MUST BE EXECUTED 
ONIY ONCE. 

THE MAXIMUM SIZE IS 
NC = 10 

CALLS FORMA SUBROUTINE ZIBOMB. 

CODED BY R L BERRY. MAY 1969. 

MODIFIED FOR CONTRACT NAS8-25922* MAY 1971, 

SUBROUTINE ARGUMENTS (ALL INPUT) 

X' C = VECTOR OF X-AXIS COORDINATES, SIZE (NR). 

YMAT = MATRIX OF Y-AXIS COORDINATES TO BE PLOTTED. SI2E(NR,NC). 

MAY BE DESTROYED. 

NR = NUMBER OF ROWS IN XVEC AND YMAT. 

NC = NUMBER OF COLUMNS IN YMAT. MAX=10. 

IXNAM.E= AN A6 NAME FOR X-AXIS COORDS. 
lYNAME- A 12A6 NAME FOR Y-AXIS COORDS. 

ITITLE= A 6A6 OFFINFO IN THE CALLING PROGRAM WHICH WILL BE 
ASSEMBLED WITH IRUNNC AND DATE TO FORM TITLE. TITLE 
WILL APPEAR AT BOTTOM OF PLOT SHEET. 

IPLDT = THE TYPE OF PLOT DESIRED. 

= 1 ESTABLISHES A SEMI-LOG MAPPING WITH Y-AXIS LINEAR. 

= 2 ESTABLISHES A SEMI-LOG MAPPING WITH X-AXIS LINEAR. 

= 3 ESTABLISHES A LOG-LOG MAPPING. 

YTOP = MAXIMUM VALUE OF Y-AXIS SCALE. 

IF .LE. 0. AND LOG AXIS* MAXIMUM VALUE WILL BE COMPUTED. 

YBOT = MINIMUM VALUE OF Y-AXIS SCALE. 

IF ,LF. 0. AND LOG AXIS, MINIMUM VALUE WILL BE COMPUTED. 

XLEFT =^- MINIMUM VALUF OF X-AXIS SCALE. 

IF .IE. 0. AND LOG AXIS, MINIMUM VALUE WILL BE COMPUTED. 

XRIGHT= MAXIMUM VALUE OF X-AXIS SCALE. 

TF ,Lf. 0. AND LOG AXIS, MAXIMUM VALUF WILL BE COMPUTED. 

KR = ROW DIMENSION OF YMAT IN CALLING PROGRAM. 

NERROR explanations 
1 = MORE THAN 10 COLUMNS IN (YMAT), 
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CHECK SIZE LIMITATION OF PROGRAM-NUMBER OF VECTORS TO BE PLOTTED 

N6RROR=l 

IF (NC .GT. 101 GO TO 999 
C 

C FORM TITLE FROM ITITLE AND COMMON 
ITITLU) = IXNAME 
ITITL(2) = 6H 
ITITL(3) = IRUNNO 
ITITL(4) = 6H 
ITTTL(5> = IDATE 
ITTTLC6) = 6K 
DO 5 1=1,6 

5 ITITL(I+6) = ITITLE(I) 

C 

C FIND MAX AND MIN OF YMAT,XVEC. 

XMAX=XVEC Cl) 

XMIN=XVFC Cl) 

YMAX = YMATn ,1) 

YMIN=YMAT(!,1) 

DO 12 1=1, NR 

IFCXVEC (I ).GT. XMAX) XMAX=XVEC(II 
IFCXVECd ).IT. XMIN) XMIN=XVEC(I) 

DO 12 J=1,NC 

IF(YMAT(I,Ji .GT. YMAX) YMmX=YMAT ( I ,J ) 

IFCYMAT(I,J) .LT. YMIN) YMIN=YMAT( I ,J) 

12 CONTINUE 
XL = XLEFT 
XR = XRIGHT 
YE = Y60T 
YT = YTOP 

IF (IPLOT .EQ. 2) GO TO 60 
C 

C X LOG SCALE DETERMINATION SECTION. 

IF (XLEFT.GT.O) GO TO 50 
X = ALOGIO (XMIN) 

IF (X .LT. G.) GO TO 45 
I = X ♦ 1. 

GO TO 48 
45 I = X 

Y = I - 1 

IF (X-Y .GE. 1.) I = 1+1 
48 XL = 10. 4*(I - 1) 

50 IF (XRIGHT .GT.O) GO TO 60 
X = ALOGIO (XMAX) 

IF (X .GE. 0.) GO TO 52 
I = X 
GO TO 53 

52 I = X + 1 . 

Y = T 

IF (Y-X .GE. 1.) 1=1-1 

53 XR = 10.**I 

C Y LOG SCALE DETERMINATION SECTION 
60 IF (IPLOl .EO. 1) GO TO 13 
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IF (YTOP .GT. 0.1 GC TO 70 

X=ALCG10(YMAXI 

IF (X.GE.O.) GC TO 10? 

I=X 

GO TO lOA 

103 I=X+1. 

Y=I 

IF (Y-X.GE.l.) 1=1-1 

104 YT=1C.»*=I 

70 IF (YBOT .GT. 0.) GO TO 13 
X = ALOGIO lYMIN) 

IF (X .LT. O.) GC TO 75 
I = X ♦ 1. 

GO TC 80 
75 I = X 

Y = I - 1 

IF «X-Y .GF. 1.1 I = !♦! 

80 YB = 10. ♦♦Cl-ll 

PRODUCE APPROPRIATE GRID 

13 IF flPLOT .EO. 1) CALL SMXYV I1»0) 

IF CIPLCT .EO. 2) CALL SMXYV 10,11 
IF (IPLCT .EO. 3) CALL SMXYV (1,11 
DO 130 1=1, NR 

IF (XVEC(I) .GT. XR) XVECdl = XR 
IF (XVECdl .LT. XL) XVECdl = XL 
DO 130 J=1,NC 

IF (YMAT(I,J1 .GT. YT 1 YMATd,J) = YT 
130 IF( YMAT(I,J1 .LT. YB 1 YMAT(I,Jl=YB 

PLOT CURVES 
.MEWGRO = -1 
DO 40 I=1,NC 

CALL XSCLVl (XVECd 1, IXRAS,IXERR1 
CALL YSCLVl ( YMATd ,I 1 , lYRAf , lYERR 1 
CALL PRINTV I 2,IN0( I 1 ,IXRAS ,IYRAS1 
CALL XSCLVl (XVEC(NR) ,IXRAS,IXERR) 

CALL YSCLVl ( YMAKNR, 1 1 ,IYRAS,IYERR 1 
CALL PRINTV ( 2,IN0( I i ,IXRAS ,I YRAS 1 
IF (I.GT.ll NEWGRP = 0 

40 CALL QUKLCG (NEWGRO,XL ,XR ,YB ,YT ,61,ITITL,IYNAME,-NR,XVEC, 
* YMATd, 111 

RETURN TO MAIN PROGRAM 
CALL SMXYV '(0,01 
RETURN 

999 CALL ZZBOMB (6HPL0T2 ,NERR0R1 
END 
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C 


C 


SUBROUTINE PLOTS (CLOC»MLOC,COELCC,VPLOC*RANGLE*CANGLE *EEO, 

» IF JNUM ,LRE YE ,NVI EW .1 FF At ITITLE «NC tNM tKC tKM > 

COMMON /LSTART/ IPUNNO,DATE ,NFAGE tUNAME f 3 I tTITLEl !12 I tTITLE2 ( 12 » 
DIMENSION CLOC<KC,1),MLCC(KM,1I,COELOC( lItVPLCCd ItlTITLECl » 
DIMENSION ABE C 3 ) ,AC1 E ( 3 ) ,AC2EC 3) tE A C3>tEAE (3|,EB (3}«E6E 131, 

♦ ECE C3),EO <3),EP <3»,EPE C3 ) ,E01 E (31 ,EQ2EC3I ,RE <31, 

♦ UX (3),UY (3),U2 (3), 1TITLXU3I 

DIMENSION NUMEER (100) , IDATA (31 

DATA NIT,NCT/5,6/ 
data TCLRNC / l.E-08 / 


DATA NUMBER 

/ 3H 

1 

,3H 

2,3H 

3, 

r3H 

4,3H 

5,3H 

6,3H 

7 

,3H 

8, 

♦ 

?H 

9 

,3H 

10,3H 

111 

r3H 

12,3H 

13,3H 

14, 3H 

15 

,3H 

16, 

♦ 

3H 

17 

,3H 

18, 3H 

19, 

► 3H 

20,3H 

21,3H 

22,3H 

23 

,3H 

24, 

* 

3H 

25 

,3H 

26,3H 

27, 

r3H 

?e,3H 

29,3H 

30, 3H 

31 

,3H 

32, 


3H 

33 

,3H 

34 ,3 H 

35, 

.3H 

36 ,3 H 

37,3H 

38 ,3H 

39, 3H 

40 , 

♦ 

3H 

-'►I 

,3H 

42 ,3 H 

^3, 

r3H 

44,3H 

45,3H 

46,3H 

47 

,3H 

48, 


?H 

49 

,3H 

50,3H 

51, 

r3h 

52,3H 

53,3H 

54,3H 

55 

t3H 

56, 

♦ 

3H 

57 

♦3H 

5B,3H 

59, 

► 3H 

60 ,3 H 

61, 3H 

62,3H 

63 

,3H 

64, 

♦ 

3H 

65 

,3H 

66,3H 

67, 

,3H 

68 ,3H 

69,3H 

70,3H 

71 

,3M 

72, 


3H 

73 

,3H 

74,3H 

75, 

»3H 

76,3H 

77,3H 

78,3H 

79 

,3H 

80, 


3H 

81 

,3H 

82, 3H 

83, 

► 3H 

84 ,3 H 

85,3H 

86,3H 

87 

,3H 

88, 

♦ 

3H 

89 

,3H 

90,3H 

91, 

r3H 

92 ,3H 

93,3H 

94,3H 

95 

,3H 

96, 

♦ 

3H 

97 

,3H 

98,3H 

99, 

r3H100 / 







EQUIVALENOE (DATE, IDA TE) 


PLOTS PERSPECTIVE OP STEREO-PAIR VIEWCSl* 
COOED BY R F HRUDA. OCTOBER 1968, 

MODIFIED FOR CONTRACT NAS8-25922, MAY 1971. 


NOTE.. -FOR TRAN STATEMENT -CALL IDENT (11- MUST BE IN LOGIC OF MAIN 
PROGRAM PRIOR TO CALLING THIS ROUTINE. IT MUST BE EXECUTED 
ONLY ONCE (INDEPENDENTLY OF THE NUMBER OF TIMES THE MAIN 
PROGRAM IS EXECUTED). 


FORTRAN STATEMENT -CALL ENDJOB- MUST BE IN LOGIC OF MAIN 
PROGRAM SUBSEQUENT TO CALLING THIS ROUTINE. IT MUST BE EXECUTED 
ONLY ONCE. 


THIS ROUTINE CALLS F(3RMA SUBROUTINES VCROSS, VDCT, Z2B0MB. 


SUBROUTINE ARGUMENTS (ALL INPUT) 

CLDC = NC-BY-3 MATRIX. THE I-TH ROW WOULD DEFINE THE X,Y,2 

COORDINATE LOCATION OF THE I-TH JOINT OF A STRUCTURE. 

MLOC = NM-BY-2 MATRIX. THIS MATRIX SPECIFIES WHICH COORDINATES 
IN THE CLOC ARE TO BE CONNECTED BY A STRAIGHT LINE PLOT. 
(I.E. PLOT FROM CLOC (MLOC ( I , 1 ) ) TO CLOC(MLOC ( I ,2 ) ) .) 

COELOC = A VECTOR DEFINING THE X,Y,Z COORDINATES OF THE 

CFNTEP-OF-EYES-LOCATION IN THE REFERENCE C(3CRD1NATE SYSTEM. 
(WHERE YOU VIEW THE OBJECT FROM.) 

VPLOC - A VECTOR DEFINING THE X,Y,Z COORDINATES OF THE 

VIEW-POINT-LOCATION. (A POINT YOU WISH TO LOOK AT 
FROM THE COELOC.) 

RANGLE = ROLL-ANGLE (IN DEGREES) YOU WISH TO ROLL YOUR HEAD ABOUT 
THE LINE OF SIGHT PRESCRIBED BY COELOC AND VPLOC. 
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(CLOCKWISf = ♦» (THE INITIAL LINE OF SIGHT FROM CCELOC IS 
DOWN THE X-AXIS WITH THE Y-AXiS TO THE RIGHT AND THE 
2-AXIS DOWN. TO LOOK AT THE VPLOC, THE LOCAL COORDINATE 
SYSTEM AT COELOC IS FIRST ROTATED ABOUT THE 2-AXIS AND 
THEN ABOUT THE Y-AXIS. RANGLE WOULD THEN PRESCRIBE A 
♦THETA-X ROTATION ABOUT THE NEK ORIENTATION OF THE LOCAL 
COORDINATE SYSTEM.) 

CANGLE = CONE ANGLE OF VISION. (A SCALING TYPE OF VARIABLE THAT IS 
DEPENDENT ON THE VIEWER. FOR MOST VIEWERS ABOUT 60 
DEGREES IS USED. IF NO VIEWER IS USED* ABOUT 20 DEGREES IS 
ACCEPTABLE.) MAX = 80 DEGREES. 

EEO = EYE-TC-EYE DISTANCE (USUALLY 3.0 INCHES) . A VARIATION OF 
THIS PARAMETER WILL CAUSE A DEPTH PERCEPTION DISTORTION. 

IFJNUM = 0, NO JOINT NUMBERS WILL APPEAR ON THE STRUCTURE. 

= 1* JOINT NUMBERS WILL BE PUT ON THE STRUCTURE. 

LREYE = It A PERSPECTIVE (LEFT EYE) VIEW WILL BE PRODUCED. 

= 2t COMPANION RIGHT EYE VIEW FOR STEREO WILL BE PRODUCED. 

NVIEW = 1, THE PLOTTED IMAGE WILL BE FULL SIZE, AND ONLY ONE VIEW 
WILL APPEAR ON ONE PLOT FRAME. 

= 2, The PLOTTED IMAGE WILL BE HALF-SIZE SUCH THAT BOTH 

VIEWS OF A STEREO PAIR HAY PE PUT ON ONE PLOT FRAME. 

(TO BE USED IN CONJUNCTION WITH LREYE AND IFFA. FOR A 
STEREO PAIR, THE LEFT EYF VIEW MUST BE PLOTTED FIRST.) 

IFFA = 0, FRAME ADVANCE WILL NOT EE EXECUTED AFTER PLOTTING 
A FRAME. 

=1, FRAME ADVANCE WILL BE EXECUTED AFTER PLOTTING IS 

COMPLETED. (MUST USE IFFA=I ON LAST PLOT EXECUTION 
IN EACH FRAME.) 

ITITLE = 13A6 PLOT TITLE. (CANNOT USE TITLEl OR TITLE2 FROM 
SUEROUTINF START) 

NC = NO. OF ROWS IN CLOC. 

NM = NC. OF FOWS IN MLOC. 

KC = FCW DIMENSION SIZE IN CALLING PROGRAM OF MATRIX CLOC. 

KM = ROW DIMENSION SIZE IN CALLING PROGRAM OF MATRIX MLOC. 


NFRPCR EXPLANATIONS 

1 = CONE ANGLE GREATER THAN 80 DEGREES. 

2 = EYE-TO-EYE DISTANCE LESS THAN l.E-8. 

3 = JOINT NUMBER OPTION (IFJNUM) MUST BE 0 OR 1. 

A = PERSPECTIVE OR STEREO OPTION (LREYE) MUST BE 1 OR 2. 

5 = VIEW OPTION (NVTEW) MUST BE 1 OP 2. 

6 = FRAME ADVANCE OPTION MUST BE 0 OR 1 . 

7 = CENTER OF EVES IS TOO CLOSE TO VIEW POINT. 

8 = MATRIX (MLOC) DATA EXCEEDS MATRIX (CLCC) SIZE. 


IF (CANGLE .GT. 80.) GO TO 9<>9 
IF (EED.LE.TOLRNC) GO TO 999 

IF (IFJNUM. NE.O .AND. IFJNUM. NE.l) GO TO 999 
IF (LREYE .NE.l .AND. LREYE. NE .2) GO TO 999 


NERR0R=1 

NERR0R=2 

NERR0R=3 

NERROR=A 


IF (NVIEW .NE.l .AND. NVIEW. NE .2) GO TO 999 


NERR0R=5> 
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NERR0R=6 

XF (IFFA.NE.O .AND, IFFA.NE.il GO TO 999 

FORM SINES AND COSINES. 

OX = VPLPCdl-COELOCC II 
OY = VPLOC(2l-CCELOC<2) 

OZ = VPLOC(3l-COELOC«3) 

0PM = S0RT(DX**2+DY**2+DZ**2) 

NERR0R=7 

IF COPM .LE. TOLRNC) GO TO 999 

THETAX = PANGLE/57.2957 

THETAY = ATAN2(-DZ,SQRT(DX**2+0Y»*2I) 

THETAZ = 0. 

IF (ABS(DY|.GT.T0LRNC.0R.ABS(DXI.GT^.T0LRNCI THETAZ = ATAN2(DY,DXl 

51 = SIN( THETAZ I 

52 = SINCTHETAYI 

53 = SIN( THETAX) 

SEYE = SIN( ATANC.5»EE0/0PM) I 
SCONE = S IN < .5*C ANGLE/57. 2 957 I 
Cl = COS( THETAZ) 

C2 = COS (THETAY) 

C3 = COS( THETAX) 

CEYE = COS(ATAN(.5*EEO/OPM)) 

CCONE = C0S(.5*CANGLE/57.2957) 

FORM CONVERSION FACTOR (UNIT RASTERS/LENGTH). 

IF (NVIEW.EO.I) SCALE = 0.A399 
IF (NVIEW.EQ.2) SCALE = 0.2A99 

CONVRT = SCALE/( (OPM/CEYE)»TAN(. 5*CANGLE/57 .29571 ) 

SET UP DATA FOR PLOTTING TITLES. 

DC 100 1 = 1,13 
100 ITITLX(I) = ITITLE(I) 

PLOT TITLE DATA. 

IF (IFFA.FO.O) GO TO 105 
IF (NVIFW.EC.2) GO TO 103 
IF (LPEYE .EO. 1) lOATA(l) = 6H LEFT 
IF (LREYE .EO. 2) IDATA(l) = 6HRIGHT 
IDATA(2) = 6HEYE VI 
IDATA(3) = 2HEW 

CALL RITF2V ( 10, 512 , 1024, 180, 1 , 14, 1 ,IDATA,IFPR) 

103 CALL PRINTV ( 78, ITI TL X,203, 107) 

CALL PPINTV (30,30HCENTER OF FYES LOCATION ,203,82) 

CALL PRINTV (38,38HVIEW POINT LOCATION ROLL ANGLE =,443,82) 

CALL LABLV (R ANGLE, 747, 82 ,6 , 1 ,3) 

CALL PRINTV ( 3 ,3HDEG, 803, 82 ) 

CALL PRINTV (6,6H X =,203,61) 

CALL LABLV (COBLOC( 1) ,259,61,-6,1,1 ) 

CALL PRINTV 0,3HX =,451,61) 

CALL LABLV ( VPLOC ( 1 ) , 486, 61 ,-6, 1 , 1 ) 

CALL PRINTV (19,19H CONE ANGLE =,595,61) 

CALL LABLV (C ANGLE, 747, 61 ,6,1 ,3) 

CALL PRINTV ( 3,3HDEG,803,61 ) 
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CALL PRINTV t6,6H Y =,203*41) 

CALL LABLV (COELOC ( 21 ,259,41,-^, 1, 1 ) 

CALL PRINTV 13, SHY =,451,41) 

CAIL LAPLV (VPL0C(2), 486, 41 ,-6,1,1) 

CALL PRINTV (19,19H EYE TO EYE =,595,41) 

CALL LABLV (EED, 747,41, 6, 1,3) 

CALL PRINTV (3,3H IN, 803, 41) 

CALL PRINTV (6,6H 2 =,203,20) 

CALL LABLV (CPELOC ( 3) ,259 ,20,-6,l , 1 ) 

CALL PRINTV C3,3HZ =,451,20) 

CALL LABLV ( VPLOC (3 ) ,486, 20 ,-6,1 , 1 ) 

CALL PRINTV (lO.lOHRUN NO. = ,203,4) 

CALL PRINTV ( 6, IRUNNO ,284,4) 

CALL PRINTV (17,17H DATE = ,364,4) 

CALL PRINTV (6,IDATE,500,4) 

105 CONTINUE 
C 

C TRANSFORM VECTORS FROM COE SYSTEM TO REFERENCE SYSTEM AND TAKE 
C ADVANTAGE OF ZEROS IN ORIGINAL VECTORS. 

SIGN = +1.0 

IF (LREYE.FC.2) SIGN = -1.0 

EO(l) = SIGN#.5*EED*(C1*S2*S3-S1»C3) 

E0(2) = SIGN*.5*EED»( S1*S2*S3+C1*C3) 

E0(3) = SIGN*.5*EED*(C2*S3) 

EPCl) = 0PM*(C1»C?)+E0(1) 

EP(2) = OPM*(S1*C2)+EO(2) 

EP(3) = CPM*(“S2) +E0(3) 

RE(n = CCELOCm-EO(l) 

RE(2) = C0EL0C(2)-E0( 2) 

RE(3) = C0EL0C(3)-E0(3) 

CALL VCPOSS (EO,EP,UX ,EOM,EPM,UXM,SINAB) 

CALL VCROSS ( EP,UX , UY ,EPM ,UXM ,UYM,S INAB ) 

CALL VCROSS ( UX,UY,UZ »UXM ,UYM ,UZM, S INAB ) 

DO 140 Nl=l,3 
UX(Nl) = SIGN*UX(N1)/UXM 
UY(Nl) = SIGN*UY(N1)/UYM 
140 UZ(Nl) = +1.0*UZ(N1)/UZM 
EPE(l) = 0. 

EPE(2) = 0. 

EPEI3) = EPM 

LOOP FOR PLOTTING THE NM MEMBERS. 


DO 330 NMEM=1,NM 

C SET UP VECTORS FRO,^ EYE TO MEMBER ENDS. 

NA = MLnC(NMEM,l) 

NB = ML0C(NMEM,2) 

NERR0R=8 

IF (NA.GT.NC .OR . NB.GT.NC) GO TO 999 
DO 160 Nl=l»3 

EA(Nl) = CL0C(NA,N1 )-RE (Nl) 

160 EB(Nl) = CLOC (NB,N1)-RE(N1) 

EAE(l) = UX(l)*FA(l)+UX(2)*EAf2)+UX(3)*FAC3) 

EAE(2) = UY(1 )*EA (1)+UY(2)*EA(?)+UY(3)*EA(3) 

EAE(3) = UZ{l)*EAm+UZ(2)»EAI2)+UZ(3)*EAC3) 
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EEEfll = UX<ll*EBm+UX(2»*EB(2l+UXC3l*EBI3l 
EBE(2I = UY«ll*EF(n+UY<2l*EB<2»*UV(3»*EB(3J 
E6E(3) = UZd »*EBni+UZC2l*Erif2l+U2l3l*EB(3J 
C CHECK IF BOTH ENDS ARE BEHIND THE EYE. 

IF fEAE(3».LE.T0LRNC .AND. EEE (3 1 .LE.TDLRNC ) GO TO 330 
C CHECK IF BOTH ENOS ARE IN CONE OF VISION. 

CALL VOOT (EPE*EAl,PROOCT,EPEM,EAEM,CCSFAI 
CALL VOOT (EPE,EBE,PRODCT,EPEM»EBEM,COSPB) 

IF (EAEM.LE.TOLRNC .OR. EBEM.LE.TOLRNCI GO TO 330 
IFNUM = O 

IF (COSPA. LT.CCONE .OR. COSPB .LT.CCONEI GO TO 170 
IFNUM = 1 

PAX = (FPEM/CCSPA»*(EAE(1 l/EAEM) 

PAY = (EPEM/C0SPAI*(EAEC2I/EAEMI 
PBX = (EPEM/C0SPB)*(EBE(1)/EBEMI 
PBY = (EPEM/CCSPB)*IEBE(2)/EBEM) 

GO TO 320 
C 

C FIND INTERSECTION OF LINE AND CONE AND DETERMINE WHICH SOLUTIONS 
C ARE VALID FOR POINTS TO BE PROJECTED CWTO VIEWING PLANE. 

170 CALL VCROSS ( E AE ♦ EBE, ECE,EAEM ,EBEM,ECEM ,SINAB I 
IF CECEM.LE.TOLRNC) GO TO 330 
CALL VOOT (EPE,ECEtPRCOCT,EPEM,ECEM,COSPC) 

CPMC = COS( (90.0-.5*CANGLEJ/57.2957 I 
C9PC = CCS( (90.0+.5*CANGLE)/57.29S7 ) 

IF (CCSPC.GF.C9MC .OR. C0SPC.LE.C9PC I GO TO 330 
BETA = ATAN2(ECE(1|,ECE(2II 
SINPPB = (-1.0/TAN( ,5<=CANGLE/57.2957))A 
♦ ( ECE ( 3 l/SQRT (ECE 1 1 l♦♦2♦ECE (2 )**2 1 1 

IF (SINPPB**2.GE..995I GO TO 330 
DENOM = SQRT(1.0-S1NPPB*A2I 
PHIl = ATAN2( SINPPB t+DENOM) -BETA 
PHIZ = ATAN2(SINPPBt-DEN0M)-BETA 
DO 180 Nl=l,3 

180 ABE(Nl) = EBE(N1)-EAE(N1) 

IFUSEl = 1 
IFUSE2 = 1 
R1 = O. 

R2 = 0. 

IF (ABSCECF(2)).GT.ABS(FCE(1) H GO TO 190 
DENOMl = ABE(31^SC0NE*SIN(PHI1)-ABE(2J*CC0NE 
0EN0M2 - AEE(3I^SCONE*SIN(PHI2)-ABE(2»»CCONE 
IF (ABSCOENOMII.LF.TOLRNCI IFUSEl = 0 
IF (ABS(DEN0M2».LE.T0LRNC) 1FUSE2 = O 
IF (IFUSEl.FO.il R1 = ECEdl/DENOMl 
IF (IFUSE2.E0.il R2 = ECE( II /DEN0M2 
GO TO 200 

190 DENOMl - APE(1|»CCCNE-ABE(3IASC0NE»C0S(PMI1| 

0ENCM2 = ABE( 1|ACC0NE-ABE(3|*SC0NE*C0S(PHI2I 
IF (APS(0EN0M1 I.LE.TOLRNC I IFUSEl = 0 
IF (AeS(0ENGM2I.LE.T0LRNC I IFUSF2 = 0 
IF (IFUSEl.EO.il R1 a ECE(2I/DEN0M1 
IF (IFUSE2.PC.il R2 = ECE ( 2> /0EN0M2 
200 IF (Rl.LE.l. lPNCI IFUSEl = 0 
IF (P2.LE.T0LRNC) IFUSE2 = 0 
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IF (IFUSE1,E0.0 .AND. 1FUSE2.EQ.0) GO TO 330 

X FORM VECTORS FROM EYE TO PROJECTED POINT AND FORM X,Y COMPONENTS IN 
C THE P-SYSTFM. 

IF (IFUSEl.EO.O) GO TO 210 
EQlE(l) = R1*C0S(PHI1 )*SCONE 
E01E(2) = R1*SIN(PHI1)*SCCNE 
E01E(3) = R1*CC0NE 
210 IF <IFUSE2.EQ.0I GO TO 220 
E02E(t) = R2^C0S(PH12)*SC0NE 
E02E(2) = P2*SIN(PHI2)»SCONE 
E02E»3J = o2*CC0NE 

220 IF tlFUSEl.EQ.l .AND. IFUSE2.EC.1) GO TO 260 
C 

IF <COSPA.LE.CCONE .AND. COSPB.LE.CCONE » 60 TO 330 

IF (IFUSEl.EO.O) GO TO 230 

EQIEM = SORT(EQlECI)**2+ECilE(2)**2+E01E(3)**2) 

PAX = (EPM/CCCNE)*(E01E(1)/EQ1EM) 

PAY = (EPM/CC0NE)^(EQ1EC2)/EQ1EM) 

GO TO 2 AD 

230 E02EM = SCRT( EC2E (1 )♦♦2♦EC2E( 2)**2+E02E (3)»*2 ) 

PAX = (EPM/CCONE)*(E02E(1)/EC?EM) 

PAY = (EPM/CCONE)*(EQ2E(2)/EQ2EM) 

240 IF (COSPA .LT.CCONE) GO TO 250 
pex = (EPM/C0SPA)*(EAE(1)/EAEM) 

PBY = (EPM/C0SPA)*(EAE(2)/EAEM) 

GO TO 320 

250 PBX = (EPM/C0SPB)»(EBE|1)/EBEM) 

PBY = (EPM/C0SPB)*(EBE(2)/EBEM) 

GO TO 320 
C 

C TWO INTERSECTION POINTS. 

C SEE IF BOTH ARE INSIDE OR BOTH ARE OUTSIDE OF AB . 

260 DO 270 Nl=l,3 

AOIE(NI) = E01E(N1)-EAE(N1) 

270 A02E(N1) = E02E(N1)-EAE(N1) 

CALL VDOT (ABE,A01E,AEQ1,ABEM,A01EM,COSA01) 

CALL VDOT (ABE,A02E,ABQ2,ABEM,AQ2EM,C0SA02) 

RATIOl = AE01/ABEM«#2 
RATI02 = AH02/APEM*#2 

IF ((RATICI.GE.1.0 .AND. RATI02.GE.1.0) .OR. 

♦ (PATIPl .LF.O.C .AND. RATI 02 .LE .0.0) ) GO TO 330 

IF ( (RATIOl .GT.0.0 .AND. RATIOl .LT . 1 .0) .AND. 

♦ (RATI02.GT.0.0 .AND. RATI02.LT. 1.0) ) GO TO 310 

ONE POINT INSIDE AND ONE POINT OUTSIDE OF AB. 

IF (RATI02.GT.0.0 .AND. R ATI02 .LT.l .0 » GO TO 280 
EQIEM - SPRT(E01E (1 )**2+EClE(2)**2+EQlE(3)**2) 

PAX = (EPM/CCONF )*(F01F(1 )/EQlFM) 

PAY = (FPM/CC0NE)*(EQ1E(2)/EQ1EM) 

GO TO 290 

280 EQ2EK SQRT( EQ2E (1 )«*2+EQ2E ( 2)*»2 + EQ2E (3)*T2 ) 

PAX = (FPM/CC0NF)*(F02E(1 )/E02FM) 

PAY = (FPM/CC0NE)»(EQ2E(2)/F0?EM) 

290 IF (COSPA. LT.CCONE) GO TO 300 
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PBX = (FPM/C0SPA)*IPAE(1)/EAEM) 

PBY = <EPM/C0SPA)*<EAE(2?/EAEM) 

60 TO 320 

300 PBX = (EPM/C0SPB»*(EBE(1>/EBEM) 

PBY = (EPM/C0SPB)*(EBE(2»/EBEK| 

60 TO 320 

BOTH POINTS INSIDE OF AB 

310 EOIEM = S0RT(E01Efl)»*2*E01E(2)**2+F01EC31**2) 
EQ2EM = S0RT(EQ2E(1 )»*2+EC2E<2)**2+EQ2E(3)**2) 
PAX = (EPM/CC0NE)»(EQ1E(1 I/EQIEMI 
PAY = (EPM/CCDNE»*IE01E(2J/E01EM) 

PBX = (EPM/CCONE)*tt02E(l )/EQ2EH» 

PBY = (EPM/CCCNE)=«=IE02EI2 )/EQ2EM» 

CONVERT TO O.-TO-l. 6RID VALUES, AND PLOT. 

320 CONTINUE 

IF INVIEM.EQ.I) BIAS = 0.500 

IF (NVIFW.EQ.2 .AND. LREYE.EQ.il BIAS = 0.250 

IF (NVIEW.FC.2 .AND. LREYE.EQ.2I BIAS = 0.750 

PAX = PAX*CONVRT-^0.560 

PAY = PAY*CCNVRT+BIAS 

PBX = PBX*C0NVRT+0.560 

PBY = PBY*CONVRT+EIAS 

IPAX = PAX * FLOAT 1102^1 

IPAY = PAY ★ FLOAT (102AI 

IPBX = PBX ♦ FLOAT C102A) 

IPBY = PBY ♦ FLOAT a02A) 

CALL LINEV (IPAY, IPAX , IPBY, IPBX I 
IF (IFNUM.EC.O .OR. IFJNUM.EO.O) GO TO 330 
IF (NA.GT.IOO .OP. NB.6T.I00I 60 TO 330 
CALL PRINTV ( 3, NUMBER (NAI , IPAY, IPAX ) 

CALL PRINTV (3,NUMBER (NB I ,IPBY, IPBX I 

330 CONTINUE 

CLEAR PLOT BUFFER FOR THE FRAME JUST COMPLETED. 

IF (IFFA.EQ.I) CALL FRAME V (31 

RETURN 

999 CALL ZZPOMB (6HPL0T3 ,NERROR) 

END 
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SUBROUTINE PLOTSS (YMAXIN,YMININtYTOP,YBOT) 

SELECT PLOT SCALE AND CALCULATE TOP, BOTTOM VALUES OF 10 SQUARE 
LINEAR PLOT GRID FROM YM AXIN ,YMININ. 

CALLS FORMA SUPROUTINE ZZBOMB. 

CODED BY RF HRUDA. SEPTEMBER 1967. 

LAST REVISION BY WA BENFIELD. MARCH 1976. 

SUBROUTINE ARGUMENTS 

YMAXIN = INPUT MAXIMUM VALUE T'J BE PLOTTED. 

YMININ = INPUT MINIMUM VALUE TO BE PLOTTED. 

YTOP = OUTPUT TOP LIMIT OF GRID. 

YBOT = OUTPUT BOTTOM LIMIl OF GRID. 

NERROR EXPLANATION 

1 s YMAX IS LESS THAN YrfiN. 

2 - SCALE CANNOT BE CALCULATED. 

YMAX = YMAXIN 
YMIN = YMININ 

NERROR = 1 

IF (YMAX ,LT. YMIN) GO TO 999 

IF (YMAX .GT. YMIN) GO TO 21 

11 IF (YMAX .LT. 0.00) GO TO 13 

YMAX = 1.001»YMAX 
YMIN = ,999*YMIN 

GO TO 15 

13 YMAX = .999*YMAX 

YMIN = 1.001*YMIN 
15 IF (YMAX .NE. 0.) GO TO 21 
YMAX = +.3 
YMIN = -.3 

21 VALUE = (YMAX-YMIN)/10. 

IF (VALUE .LT. ABS( YM IN/100000. ) ) GO TO 11 
DO 23 1=1,66 
DO 23 J=l,3 

SCALE = 2,**(J-2) *10.**C-33) 

IF (SCALE .GE. VALUE) GO TO 31 
23 CONTINUE 

NERROR = 2 

GO TO 999 

31 NSTEPS = YMIN/SCALE 

YBOT = FLOAT(NSTEPS)>FSCALE 

32 IF (YMIN) 34,38,36 

33 YBOT = YBOT-SCALE 

34 IF (YBOT ,LE. YMIN) GO TO 38 
GO TO 33 

35 YBOT = YPOT+SCALE 

36 IF (YBOT-YMTN) 35,38,37 

37 YBOT = YBOT-SCALE 

38 YTOP = YBOT+10.*SCALE 

IF (YTOP .GE. YMAX) RETURN 
IF (J .LT, 3) GO TO 39 
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J = 0 
I = I+l 
39 J = J+1 

SCALE = 2,**(J-2) *10.**CI-33) 
GO TO 32 

999 CALL ZZBOMB (6HPL0TSS, NERROR) 
END 
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SUBROUTINE PUNCAN ( IAtNR,NCtANAME, KR J 
DIMENSION IA(KR,U 

PRODUCES PUNCHED CARD OUTPUT USABLE FOR SUBROUTINE READAN* 
CODED BY JOHN ADMIRE *NASA* OCT 1974. 

SUBROUTINE ARGUMENTS (ALL INPUTI 
lA = MATRIX TO BE PUNCHED. SIZE (NRfNC). 

NR = NUMBER OF ROWS IN MATRIX A. 

NC = NUMBER OF COLS IN MATRIX A. 

ANAME = MATRIX IDENTIFICATION. ( A6 FORMAT). 

KR = ROW DIMENSION OF A IN CALLING PROGRAM. 

4010 FORMAT (A6»I4,I5) 

4020 FORMAT <2I5,10A6) 

4030 FORMAT i lOHOOOOOOOOOO ) 

C 

PUNCH 4010f ANAME, NR, NC 
C 

DO 60 1=1, NR 
JS = 1 

10 JE = JS+O 

IF (JE .GT. NC) JE=NC 
C SEE IF ELEMENTS ARE ZERO. 

DO 20 J=JS,JE 

20 IF(IA(I,J) .NE. 6H ) GO TO 35 

GO TO 40 

35 PUNCH 4020, I , JS , ( » A* I , J ) , J=JS,JE) 

40 IF (JE .EQ. NC) GO TO 60 
JS = JS-HO 
GO TO 10 
60 CONTINUE 
C 

PUNCH 4030 

RETURN 

END 
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SUBROUTINE PUNCH ( A,NR.NC,ANAME,KR ) 

DIMENSION A(KR,1| 

PRODUCES PUNCHED CARD OUTPUT USABLE FOR SUBROUTINE READ, 
CODED BY RL WOHLEN. DECEMBER 1966. 

SUBROUTINE ARGUMENTS (ALL INPUT! 

A = MATRIX TO BE PUNCHED. SIZE (NR,NC). 

NR = NUMBER OF ROWS IN MATRIX A- 
NC = NUMBER CF COLS IN MATRIX A. 

ANAME = MATRIX IDENTIFICATION. ( A6 FORMAT). 

KR = ROW DIMENSION OF A IN CALLING PROGRAM. 

AOlO FORMAT (A6«I4,I5) 

4020 FORMAT (2I5.4E17.8! 

4030 FORMAT ( lOHOOOOOOOOOO ! 

C 

PUNCH 4010, ANAME, NR, NC 
C 

DO 60 1=1, NR 
JS = 1 

10 JE = JS+3 

IF (JE .GT. NC) JE=NC 
C SEE IF ELEMENTS ARE ZERO. 

DO 20 J=JS,JE 

20 IF (A(I,J) .NE. 0.) GO TO 35 
GO TO 40 

35 PUNCH 4020, I , JS , ( A ( I , J) , J=JS,JE) 

40 IF (JE .EQ. NC) GO TO 60 
JS = JS+4 
GO TO 10 

60 continue 
C 

PUNCH 4030 

RETURN 

END 
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SUBROUTINE PUNCHO *A tNR,NC ,ANAME*KR) 

DIMENSION A<KR,1) 

PRODUCES PUNCHED CARD OUTPUT IN OCTAL, USABLE FOR SUBROUTINE RE ADO, 
CODED BY CHRIS CHASE. MARCH 196'P. 

SUBROUTINE ARGUMENTS (ALL INPUT) 

A = MATRIX TO BE PUNCHED. SIZE (NR,NC). 

NR = NUMBER OF ROWS IN MATRIX A. 

NC = K' JMBER OF COLS IN ilATR IX A. 

ANAME = MATRIX IDENTIFICATION. ( A6 FORMAT). 

KR = ROW DIMENSION OF A IN CALLING PROGRAM. 

4010 FORMAT (A6,I4,15) 

4020 FORMAT (2 15 ,3(3X,012) ) 

4030 FORMAT ( 1 OHOOOOOOOCOO > 

C 

PUNCH 4010, ANAME, NR, NC 
C 

DO 60 1=1, NR 
JS = 1 

10 JE = JS+2 

IF (JE .GT. NC) JE=NC 
C SEE IF elements ARE ZERO. 

DO 20 J=JS,JE 

20 IF IA(1,J) .NE. 0.) GO TO 35 
GO TO 40 

35 PUNCH 4020, I , JS , ( A ( I , J ) , J=JS,JE) 

40 IF (JE .EC. NC) GO TO 60 
JS = JS+3 
GO TO 10 
60 CONTINUE 
C 

PUNCH 4030 

RETURN 

END 
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SUERCIITINF PUNCIMf IA,NR,NC*ANAME,KR| 

1 DIMENSION IA(KR,n 

C 

C PRODUCES PUNCHED CARO OUTPUT USABLE FOP SUBkOUTINE READIM. 
C COOED BY JOHN ADMIRE *NASA* OCT 1R74. 

C 

C SUFRCUTINF ARGUMENTS CALL INPUT) 

C lA - MATRIX TO BE PUNCHED. SIZE CNR«NC). 

C NR = Nl-KBER OF ROWS IN MATRIX A. 

C NC = NUMBER CF COLS IN MATRIX A. 

C ANAME = MATRIX IDENTIFICATION. CA6 FORMAT). 

C KR = ROW DIMENSION OF A IN CALLING PROGRAM. 

AGIO FORMAT CA6,I4,1E) 

4020 FORMAT (1615) 

4030 FORMAT ( ICHOOOOOOOOCO ) 

C 

PUNCH 4010, ANAME, NR, NC 
C 

DO 60 1=1, NR 
JS = 1 

10 JE = JS+13 

IF (JE .GT, NO JE=NC 
C SEE IF ELEMENTS APE ZERO. 

00 20 J=JS,JE 

20 IFCIA(I,J) .NE. 0) GO TO 35 
GO TO 40 

35 PUNCH 4020, I ,JS, (IA( i, J) , J=JS,JE) 

40 IF (JF .EO. NC) GO TO 60 
JS = JS+14 
GO TO 10 
60 CONTINUE 
C 

PUNCH 4030 

RETURN 

END 
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SUBROUTINE RBTGl (XYZ .XYZREF, JDOF, JVFC.ReT.NNODES.NRReT.NCReT* 

♦ KXJ.KRI 

DIMENSION XYZ (KX J ,I } , XYZREF (IJ , JOOF <KXJ,1 ), JVECd 1 ,RBT(KR,1 1 , 

♦ IVEC(61 «Wt6,6 ) 

GENERATES A RIGID-EOOY-TRANSFORMATION IN CARTESIAN COORDINATES. 

CALLS FORMA SUBROUTINES REVADD »ZZB0M6 . 

DEVELOPED BY RF MRUDA. APRIL 1969 
LAST REVISION BY WA BENFIELD. MARCH 1976. 

SUBROUTINE ARGUMENTS 

XYZ = INPUT MATRIX OF X;V,z COORDINATE LOCATIONS FOR EACH NODE 

POINT. SIZFINNCDES,31. 

XYZREF = INPUT VECTOR OF X,Y,Z COORDINATE LOCATIONS FOR THE 

RFFERENCF POINT. SIZEO). 

JDOF = INPUT MATRIX- EACH ROW IS USED AS AN IVEC TO REVADD X,Y,Zt 

TX,TY,TZ NODE DEGREES OF FREEDOM INTO ROWS OF RBT. EACH 
OF THESE DEGREES OF FREEDOM ARE ASSUMED TO BE IN THE 
SAME DIRECTION AS ITS CORRESPONDING REFERENCE DEGREE 
OF FREEDOM. A NEGATIVE VALtT IN JDOF CAUSES THE CORP.ES- 
PCNDING ROW OF RBT TO BE ZERO, SIZE (NN00cS*6). 

JVEC = INPUT VECTOR. USED AS A JVEC TO REVADD X,Y,ZtTX,TY,TZ REFERENCE 

DEGREES OF FREEDOM INTO COLUMNS OF RBT, NEGATIVE SIGNS 
ENABLES CHANGE FROM ASSUMED RIGHT HAND SYSTEM TO ONE YOU 
WISH TO SPECIFY. SIZE 161. 

RET = OL?TPUT RIGID BODY TRANSFORMATION MATRIX. SIZE<NP.RBT,NCRBTI . 
NNODES = INPUT NUMBER OF NODES. ROW SIZE OF MATRICES XYZ, JDOF. 

•c NRRBT = OUTPUT NUMBER OF ROWS IN RBT. EQUAL TO NON- ZEROS IN JOCF. 

C NCRBT = OUTPUT NUMBER OF COLS IN RBT. EQUAL TO NON-ZEROS IN JVEC. 

C KXJ = INPUT ROW DIMENSION OF XYZ, JDOF IN THE CALLING PROGRAM. 

C KR = INPUT ROW DIMENSION OF RBT IN THE CALLING PROGRAM. 

C 

C NERROR EXPLANATION 

C 1 = NUMBER CF NCN-ZEROES IN MATRIX IMAT EXCEEDS 
C ROW DIMENSION OF MATRIX RBT, 

C 

NRRBT = 0 
NCPET = 0 
DO 10 J=l,6 

10 IF UVEf (J).NE.O) NCRBT = NCRBT+1 
00 20 1 = 1, NNODES 
DO 20 J=l,6 

20 IF ( JOOF( I,J) .NE.O) NRRBT = NRRBT+1 

NERR0R=1 

IF (NRRBT.GT.KR? GO TO 999 
C 

30 DO 40 1=1, NRRBT 
DO 40 J-1, NCRBT 
40 RPT(l,j) = 0.0 
DO 60 1=1,6 
DC 50 J=l,6 
50 W(1,J) = G.O 
60 W(I,n = 1,0 
DU 80 1=1, NNODES 
W(l,5) = IXYZ<I,3)-XY7REr(3) I 
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W(l,6| = -<XYZ(I,2)-XYZREF<2» ) 

W(2,«^l = -fXYZn*3l-XYZREF(3) 1 
W(2,6| = fXYZfI*ll-XYZREF(in 
W(3,4) = (XYZ(I*2I-XYZREFC2) I 
WC3,5) = -(XYZfltll-XYZREFdll 
DC 70 J=l,6 
IVEC(J)=JOCFCI,JI 
IF <IVEC( JI.LT.OI IVEC(J»=0 
IF (JVEC( JI.LT.OI IVECfJI = -IVEC<JI 
70 CONTINUE 

80 CALL REVADO ( l.,W,IVEC*JVEC,RBT,6,6*NRRBT»NCRBT,6*KRI 
RETURN 

999 CALL ZZBOKB C6HRBTG1 ,NERROR| 

END 
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SUPROUTIME R6TG2 (XRT,XYZREF, JOOF, JVEC,RBT,NNODES,NRRBT,NCRBT, 

♦ KXJ,KR) 

DIMENSION XPT(KXJ,n,XY2REF(l ), JDOF (KXJ ,1»* JVECd I tRBTIKR ,1 ) , 

♦ IVECI6I ,W(6,6) 

GENERATES A RIGIO-PODY-TRANSFORMATION FROM 
CYLINDRICAL TO CARTFSIAN COORDINATES 
CALLS FpPMA SUBROUTINES RE VADO ,ZZBOMB . 

DEVELOPED PY RF HRUDA. JAN 1970-> 

LAST REVISION BY WA BENFIELD. MARCH 1976. 

SUBROUTINE ARGUMENTS 

XRT = INPUT MATRIX OF X,R,THETA(DEGREES) COORDINATE LOCATIONS 

FOR EACH NODE POINT. S IZ E< NNOOES ,3 ) . 

XYZREF = INPUT VECTOR OF X,Y,2 COORDINATE LOCATIONS FOR THE 

REFERENCE POINT. SIZEC3). 

JDOF = INPUT MATRIX. EACH ROW IS USED AS AN IVEC ItJ REVADD X,R»T, 

TX,TR,TT NODE DEGREES OF FREEDOM INTO ROWS OF RBT. EACH 
OF these DEGREES OF FREEDOM ARE ASSUMED TO BE IN THE 
SAME DIRECTION AS ITS CORRESPONDING REFERENCE DEGREE 
OF FREEDOM. A NEGATIVE VALUE IN JOOF CAUSES THE CORRES- 
PCNOING ROW OF RBT TO BE ZERO- SIZE |NN0DES»6). 

JVEC = INPUT VECTOR. USED AS A JVEC TO REVADD X*Y ,Z t TX ,TY, TZ REFERENCE 

DEGREES OF FREEDOM INTO COLUMNS OF RBT- NEGATIVE SIGNS 
ENABLES change FROM ASSUMED RIGHT HAND SYSTEM TO ONE YOU 
WISH TO SPECIFY. SIZE (6». 

RBT = OUTPUT RIGID BODY TRANSFORMATION MATRIX. SIZEINRRBT.NCRBT I . 
NNOOES = INPUT NUMBER OF NODES. ROW SIZE OF MATRICES XRT, JDOF. 

NRRBT = OUTPUT NUMBER OF ROWS IN RBT- EQUAL TO NON-ZEROS IN JDOF. 

NCRET = OUTPUT NUMBER OF COLS IN RBT. EQUAL TO NON-ZEROS IN JVEC. 

KXJ = INPUT ROW DIMENSION OF XRT, JDOF IN THF CALLING PROGRAM. 

KR = INPUT ROW DIMENSION OF RBT IN THE CALLING PROGRAM. 

NERRCR EXPLANATION 

I = NUMBFP PE NPN-2ERPES IN MATRIX IMAT EXCEEDS 
ROW DIMENSION OF MATRIX RBT. 

NRRPT = 0 
NCRBT = 0 
on 10 J=l,6 

10 IF (JVEC( J).NE.O) NCRBT = NCRET+1 
00 20 1=1, NNOOES 
DP 20 J=l,6 

20 IF (JOOF( I, J) .NE.O) NRRBT = NRRBT+1 

NERR0R=1 

IF (NPR6T.GT.KP ) GO TO 999 
C 

DO 40 1=1, NRRBT 
DO 40 J=l, NCRBT 
40 RBT(I,J» = 0.0 
DC 50 T=l,6 
on 50 J=l,6 
50 W(1,JI = 0.0 

c 

RPD = 3.1415926535898 / 180. 
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YO = XY2REF(?) 

I ZO = XYZREF(2l 

C 

DO 80 I=1,NN0DES 

XO = (XRT(I,1) - XYZREFini 

RI = XRT(I,2) 

SI = S1KMXRT<I,3I*RP0) 

Cl = COStXRTdtSl’O'RPDI 
C 

W(l,l) = 1. 

W(l,5) = <SI*RI» -ZO 
W(l*6) = -»CI*RII +Y0 
W(2,2) = C! 

W(2,3) = Si 

W(2,Ai = -(SI-YOI ♦(CI^ZOl 
WC2.5) = -(Si^^XDI 
W(2,6) = CI*XO 
WC3,2I = -SI 
W(3,3) = Cl 

M(3,*^l = -fCI^YCI -(SI*ZOI +RI 
W(3,5I = -(CI=^XD) 

W(3,6) = -(SI*XD) 

W(A,A) = 1. 

W(5,5) = Cl 
W(5,6) = SI 
W(6,5I = -SI 
W<6,6I = Cl 

c 

DO 70 J=l,6 
IVEC(J|=JOOF(I,J) 

IF (IVEC( Ji.LT.OI IVEC(J)=0 
IF <JVEC( J) .LT.Oi IVEC(J) = -IVECfJI 
70 CONTINUE 

80 CALL REVADD ( l.,W,IVEC,JVEC,RBT,6,6,NRRBT,NCRBT,6*KR| 
RETURN 
C 

999 CALL ZZBOME (6HRBTG2 ,NERRCRI 
END 
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SUPROUTINE READ ( A, NR ,NC,KR ,KC J 

DIMENSION A(KR»1) ,X(4|,IREMRK <9) 

COMMON / LLINE/ NLINE »MAXLIN,MIN1 
DATA NIT,NCT/5,6/ 

READ MATRIX OF REAL NUMBERS FROM CARDS OR TAPE AND PRINT IT. WRITE 
MATRIX ON TAPE IF SC INDICATED (BY HAVING THE WRITE-TAPE NUMBER IN 
COLUMNS 79-80). 

THE EXPLANATION OF FORMATS USED BELOW IS ... 

A - DENOTES ANY KEY PUNCH SYMBOL. (EG, A1/*C». 

I - DENOTES AN INTEGER NUMBER. (EGt 436). 

E - DENOTES A REAL NUMBER. (EGt 24.963). 

*♦♦♦ CARD INPUT 

FIRST CARD - MATRIX NAME, NUMBER OF ROWS, NUMBER OF COLUMNS 
WITH A6,IA,I5 FORMAT. 

- REMARKS IN COLUMNS 16-69. A-TYPE FORMAT. 

- $ IN COLUMN 72 FOR WRITE-TAPE INITIALIZATION. 

- VJRITE-TAPE CONTROL IN COLUMNS 73-78. MAY BE BLANK, OR 
THE WORDS REWIND OR LIST, OR (WHEN $ IN COLUMN 72) 

THE WRITE-TAPE-ID (EG, T1234). 

- WRITE-TAPE NUMBER IN COLUMNS 79-80. (EG, 21). 

MIDDLE CARDS - DATA WITH FORMAT (215, 4E17). 

- 1-ST 15 IS THE ROW NUMBER. 

- 2-ND 15 IS THE COL NUMBER OF THE NEXT E17 FIELD. 

- NEXT 4E17 are ELEMENTS OF THE MATRIX. 

LAST CARD - TEN ZEROS IN COLUMNS 1-10. 

**** tape INPUT *♦♦♦ 

ic ONE CARD - matrix NAME, ZERO OR MINUS THE LCXATION NUMBER OF MATRIX 
C ON READ-TAPE, READ-TAPE NUMBER (IF MINUS, NO PRINTOUT), 

C MATRIX RUN NUMBER WITH A6,I4,I5,A6 FORMAT. 

C - READ-TAPE CONTROL IN COLUMNS 22-27. MAY BE BLANK, OR THE 

C WORDS REWIND OR LIST. 

C - REMARKS IN COLUMNS 2 8-69. A-TYPE FORMAT. 

C - J IN COLUMN 72 FOR WRITE-TAPE INITIALIZATION. 

C - WRITE-TAPE CONTROL IN COLUMNS 73-78. MAY BE BLANK, OR 

C THE WORDS REWIND OR LIST, OP (WHEN f IN COLUMN 72) 

C THE WPITE-TAPE-ID (EG, T123^). 

C - WRITE-TAPE NUMBER IN COLUMNS 79-80. (EG, 21). 

C CALLS FORMA SUPROUTINES INTAPE ,LTAPE ,P AGEHD ,RTAPE , WR ITE ,WTAPE ,Z2B0MB. 
C CODED BY RF HRUDA. JULY 1968. 

C MODIFIED FDR CONTRACT NAS8-25922, OCTOBFR 1970. 

C MODIFIED P.Y JOHN ADMIRF *NASA* SEPT 1973 
C LAST REVISION BY RL WOHLEN. APRIL 1976. 

C 

C SUBROUTINE ARGUMENTS 

C A = OUTPUT MATRIX READ FROM CARDS OR TAPE. 

C NR = OUTPUT NUMPER OF ROWS IN MATRIX A. 

C NC = OUTPUT NUMBER OF COLS IN MATRIX A. 

C KR - INPUT ROW DIMENSION OF A IN CALLING PROGRAM. 

C KC = INPUT COL DIMENSION OF A IN CALLING PROGRAM. 

C 

NERROR EXPLANATION 

^ 1 = POW SIZE EXCEEDS ROW DIMENSION OR 

'C COLUMN SIZE EXCEEDS COLUMN DIMENSION. 

C 2 = ROW OR COLUMN VALUE OF ELEMENT EXCEEDS MATRIX SIZE. 
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f, 3 - DATA ON CARO PAST MATRIX COLUMN SIZE. 

|: 4 = LOCATION ON TAPE PAST ENO-OF-TAPE MARK. 
C 5 = LOCATION ON TAPE PAST END-OF-TAPE MARK. 
C 


1001 FORMAT 

1002 FORMAT 

2001 FORMAT 
♦ 

2002 FORMAT 
* 

2003 FORMAT 

2004 FORMAT 

2005 FORMAT 

2006 FORMAT 


(A6,I4,15,9A6, 2XA1,A6,I2) 

(2I5,4E17.0) 

{//19H CARD INPUT MATRIX A6» 2X 1H« 14, 2H X 14, 2H ) 
2X 9A6,2X A1,A6,I4//I 

(//19H CARD INPUT MATRIX A6, 2X 1H( 14, 2H X 14, 2H I 
3X 9HC0NTINUED //} 

{// 1XA6,I4,I5,5X 9A6,2X A1,A6,I41 
(IX 2I5,1P4E17.8I 
(13H0EN0 OF READ.) 

(25H0SIZE OF MATRIX READ IS (I4,2H X I4,2H » ) 


2007 F0RMAT(/,1X,123(1H-M 


READ IN HEADER CARD. 

READ (NIT, 1001) ANAME,N1,N2,IREMRK,IZ1, IZ2,NMTAPE 
NR = N1 
NC - N2 

IF(N1 .GT. 01 GO TO 50 
IF (MINI .NE. 4HMINI) GO TO 40 
IF(NLINE .LE. 5) GO TO AO 
IE(NLINE+9 .GT. MAXLINI GO TO 40 
WRITE(NOT,2G07) 

NLINE=NLINE+2 
GO TO 200 
40 CALL PAGEHD 
GO TO 200 

CARO READING SECTION. 

50 IF (MINI .NE. 4HMINI) GO TO 60 

IF(NLINE .LE. 5 .OR. NLINE .GE. MAXLINI GO TO 60 
NBC=NC/ 4 

IF( 4^NBC .NE. NCI NBC=NBC+1 
NN=9+NR»NFC 

IF(NN ♦NLINE .GT. MAXLINI GO TO 60 
HRITE(NOT, 20071 
NLINE=NLINE+2 
GO TO 70 
60 CALL PAGEHD 
70 CONTINUE 

WRITE (NOT, 2001) ANAME,NR,NC, IREMRK,IZ1 ,IZ2,NHTAPE 
NLINE=NLINE+5 

NERROR = 1 

IF (N*?.GT.KR ,CR. NC.GT.KC) GO TO 999 
DO 105 1=1, NR 
DO 105 J=1,NC 
105 A(I,J) = 0. 
liO READ (NIT, 10021 I,JS,X 

IF (I.EO.O .AND. JS.EO.OI GO TO 300 

NERROR = 2 

IF (I.LE.O .OR. I.GT.NR .OR. JS.LE.O .OR. JS.GT.NC) GO TO 998 
JE = JS+3 
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IF (JE.LE.NC) GO TO 115 
JX = NC-JS+? 

NERROR = 3 

DO 112 J=JX,4 

112 IF{AB?(X(jn .GT. 0,1 GO TO 998 
JF = NC 
115 N = 0 

00 120 J=JS,JE 
N = N+1 

120 A(I,J) = X(NI 

IF(NLINE+1 .LE. MAXLIN) GO TO 125 
CALL PAGEHD 

WRITE (NOT, 2002) ANaME,NR,NC 
NLINE=NLINE+5 

125 WRITE (NOT, 2004) I, JS ,( A( I, J) JE) 

NLINE=NLINE+1 
GO TO 110 

TAPE READING SECTION. 

200 WRITE (NOT, 2003) ANAME,N1 ,N2, IREMRK ,IZ1 ,IZ2 ,NWTAPE 
NLINE=NLINE+3 
NRTAPE = IABS(N2) 

IF (IREMRK(2) .EQ. 6HREWIND) REWIND NRTAPE 
IF (IREMRK(2) .EO. 4HLIST) CALL LTAPE (NRTAPE) 

IF (Nl.EQ.O) GO TO 250 
C POSITION NRTAPE. 

[ READ (NRTAPE) TID,LN,IEOTCK 

NUM = LN+Nl 
IF (NUM) 205,220,225 

205 NERROR = 4 

IF (lEOTCK .EO. 3HE0T) GO TO 997 
READ (NRTAPE) OUM 
NUM = -NUM-1 
IF(NUM .EO. 0) GO TO 240 
DO 210 L=l,r'M 

READ (NRTAPE) TID,LN ,IEOTCK 

NERROR = 5 

IF (lECTCK .EO. 3HE0T) GO TO 997 
210 READ (NRTAPE) DUM 
GO TO 240 

220 BACKSPACE NRTAPE 
GO TO 240 
225 REWIND NPTAPE 
NUM = (-Nl-1)*2 
IF (NUM .EO. 0) GO TO 240 
DO 230 L=1,NUM 
230 READ (NRTAPE) OUM 

240 IFdPFMRKd) .NF . 6H ) GO TO 250 

READ (NR TAPE) TID, LN, DUM , IREMRK ( 1 ) ,ANAm 
NERROR-6 

IF (LN+Nl .NE. 0) GO TO 999 
NFRR0R=7 

IF (AN AM .NE. ANAME) GO TO 999 
BACKSPACE NPTAPE 

250 CALL RTAPE ( IREMRK (1 ), ANAME, A, NR, NC,KR ,KC, NR TAPE ) 
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WRITE (NOT, 20061 NR,NC 
NLINE=NLINF+2 

IF (N2 .GT. 01 CALL WRITE ( A,NR,NC*ANAME*KR I 

TAPE WRITING SECTION. 

300 IF (NWTAPE.LE.O) GO TO 400 

IF (IZl .EC. 1H$1 CALL INTAPE (NWT APE, 1221 

IF (IZ2 .EC. 6HREWIN0I REWIND NWTAPE 
CALL WTAPE ( A,NR ,NC, ANAME,KR ,NWTAPE I 
IF (IZ2 .EO. 4HLIST) CALL LTAPE (NWTAPE) 

C 

400 WRITE (NOT, 20051 
NLINE=NLINE+2 
RETURN 
C 

997 CALL LTAPE (NRTAPEl 
GO TO 999 

998 WRITE (NOT, 20041 I,JS,X 

999 CALL ZZBOMB (6HREAD ,NERR0R1 
END 
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SUBROUTINE READAN f lA ,NR ,NC ,KR ,KC I 
DIMENSION IA(KR»l)tIX(10) ,IREMRK(9) 

COMMON / LLINE/ NLINE ,MAXLIN,MINI 
DATA NIT,N0T/5*6/ 

READ MATRIX OF ALPHA-NUMERIC CHARACTERS (A6» FROM CARDS OR TAPE AND 
PRINT IT. WRITE MATRIX ON TAPE IF SO INDICATED (BY HAVING THE 
WRITE-TAPE NUMER IN COLUMNS 79-80). 

THE EXPLANATION OF FORMATS USED BELOW IS ... 

A - DENOTES ANY KEY PUNCH SYMBOL. (EG, A1/*C). 

I - DENOTES AN INTEGER NUMBER, (EG, 436). 

**** CARD INPUT 

FIRST CARD - MATRIX NAME, NUMBER OF ROWS, NUMBER OF COLUMNS 
WITH A6, 14,15 FORMAT. 

- REMARKS IN COLUMNS 16-69. A-TYPE FORMAT. 

- $ IN COLUMN 72 FOR WRITE-TAPE INITIALIZATION. 

- WRITE-TAP E CONTROL IN COLUMNS 73-78. MAY BE BLANK, OR 
THE WORDS REWIND OR LIST, OP (WHEN * IN COLUMN 72) 

THE WRITE-TAPE-ID (EG, T1234). 

- WRITE-TAPE NUMBER IN COLUMNS 79-80. (EG, 21). 

MIDDLE CARDS - DATA WITH FORMAT (215, 20A6). 

- 1-ST 15 IS the row NUMBER. 

- 2-ND 15 IS THE COL NUMBER OF THE NEXT 15 FIELD. 

- NEXT 10A6 ARE ELEMENTS OF THE MATRIX. 

LAST CARD - TEN ZEROS IN COLUMNS 1-10. 

TAPE INPUT ♦♦♦♦ 

ONE CARD - MATRIX NAME, ZERO OR MINUS THE LOCATION NUMBER OF MATRIX 
ON read-tape, READ-TAPE NUMBER (IF MINUS, NO PRINTOUT), 
MATRIX RUN NUMBER WITH A6,14,I5,A6 FORMAT, 

- READ-TAPE CONTROL IN COLUMNS 22-27, MAY BE BLANK, OR THE 
WORDS REWIND OR LIST. 

- REMARKS IN COLUMNS 26-69. A-TYPE FORMAT. 

- $ IN COLUMN 72 FOR WRITE-TAPE INITIALIZATION. 

- WRITE-TAPE CONTROL IN COLUMNS 73-7R. MAY PE BLANK, OR 
THE WORDS REWIND OP LIST, OR (WHEN $ IN COLUMN 72) 

THE WRITE- TAPE-ID (EG, T1234). 

- WRITE-TAPE NUMBER IN COLUMNS 79-80. (EG, 21). 

CALLS FORMA SUBROUTINES INTAPE ,LTAPE , PAGEHD,RTAPE ,WR ITAN , WTAPE ,ZZBOMB. 
COOED BY JOHN ADMIRE *NASA* OCT 1974. 

LAST REVISION BY PL WOHLEN, APRIL 1976. 

SUBROUTINE ARGUMENTS 

lA = OUTPUT MATRIX READ FROM CARDS OR TAPE. 

NR OUTPUT NUMBER OF ROWS IN MATRIX lA . 

NC = OUTPUT NUMBER OF COLS IN MATRIX lA. 

KC = INPUT COL DIMENSION OF lA IN CALLING PROGRAM. 

KR INPUT ROW DIMENSION OF lA IN CALLING PROGRAM. 

NERROR EXPLANATION 

1 = ROW SIZE EXCEEDS ROW DIMENSION OR 
COLUMN SIZE EXCEEDS COLUMN DIMENSION. 

2 = ROW OR COLUMN VALUE OF ELEMENT EXCEEDS MATRIX SIZE. 

. 3 = DATA ON CARD PAST MATRIX COLUMN SIZE. 

C 4 = LOCATION ON TAPE PAST END-OF-TAPE MARK. 

C 5 = LOCATION ON TAPE PAST END-OF-TAPE MARK. 
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1001 FORMAT 

1002 FORMAT 
2001 FORMAT 

♦ 


(A6«I4tI5«9A6t 2XAltA6fI2l 
(2I5,10A6I 

(//33H CARD INPUT ALPHA-NUMERIC MATRIX A6, 

2X IHf 14, 2H X I4,2H i 


♦ 

2002 FORMAT 
♦ 


2X 9AA,2X A1,A6,I4//| 

(//33H CARD INPUT ALPHA-NUMERIC MATRIX A6* 

2X 1H( 14, 2H X 14, 2H I 


* 3X 9HC0NTINUED //I 

2003 FORMAT (// 1XA6,I4,I5 ,5X 9A6,2X A1,A6,I4) 

2004 FORMAT (IX 2I5,10A6) 

2005 FORMAT (15H0EN0 OF REAOAN-I 

2006 FORMAT (25H0SI2E OF MATRIX READ IS (I4,2H X 14, 2H I ) 

2007 F0RMAT(/,lX,123(lH-n 


READ IN HEADER CARD, 

READ (NIT, 1001) ANAME,N1,N2,IREMRK,IZ1, IZ2,NWTAPE 
NR = N1 
NC = N2 

IF(N1 .GT. 0) GO TO 50 
IF (MINI .NE. 4HMINI) GO TO 40 
IF(NLINE .LE. 5) GO TO 40 
IF(NLINE+9 .GT. MAXLIN) GO TO 40 
WRITE(NCT,2007) 

NLINE=NLINE+2 
GO TO 200 
40 CALL PAGEHO 
GO TO 200 

50 IF (MINI .NE. 4HMIN1) GO TO 60 

IF(NLINF .LE. 5 .OR. NLINE .GE. MAXLIN) GO TO 60 
NBC=NC/10 

IF()0*NBC .NE. NC) NBC=NBC+1 
NN=9+NR*NBC 

IF(NN ♦NLINE .GT. MAXLIN) GO TO 60 
WRITE(NOT,2007) 

NLINE=NLINE+2 
GO TO 70 
60 CALL PAGEHO 
70 CONTINUE 

CARD READING SECTION. 

WRITE (NOT, 2001) AN AME ,NR ,NC, IREMRK , IZl , IZ2 ,NWTAPE 
NLINE=NLINE+5 

NERROR = 1 

IF (NR.GT.KR .OR. NC.GT.KC) GO TO 999 
OP 105 1=1, NR 
00 105 J=1,NC 
105 IA(I,J) = 6H 
110 READ (NIT, 1002) I,JS,IX 

IF (I.EO.O .AND. JS.EQ.O) GO TO 300 

NERROR = 2 

IF (I.LF.O .OR. I-GT.NR .OR. JS.LE.O .OR. JS.GT.NC) GO TO 998 
JE = JS+o 

IF (JF.LE.NC) GO TO 115 
JX = NC-JS+2 
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NERROR = 3 

DO 11? J=JX,10 

112 IF (IXU) .NE. 6H ) GO TO 998 

JE = NC 
115 N ^ 0 

DO 120 J=JS*JE 
N = N+1 

120 IA(I,J) = IX(NI 

IF(NLINE+1 .LE. MAXLIN) GO TO 125 
CALL PAGEHD 

WRIT.: (N'OT,2002) ANAME,NR*NC 
NLINE-NLINE+5 

125 WRITE (N01,2004l I , JS • ( IA( I • J ) « J=JS , JE) 

NL1NE=NLINE+1 
GO TO 110 

TAPE READING SECTION. 

200 WRITE (NOT,20O3) ANAME,N1 ,N2, IREMRK ,IZ1 »IZ2 tNWTAPE 
NLINE=NLINE+3 
NR TAPE = IABSJN2) 

IF (IREMRKI?) .EQ. 6HREWIND) REWIND NRTAPE 
IF (IREMPK(2) .EQ. 4HLIST) CALL LTAPE (NRTAPE) 

IF (NI.EO.O) GO TO 250 
C POSITION NRTAPE. 

READ (NRTAPE) T ID, LN t IEC7CK 
NUM = LN+Nl 
IF (NUM) 205,220,225 

205 NERROR = 4 

IF (lEOTCK .EO. 3HE0T) GO TO 997 
READ (NRTAPE) OUM 
NUM = -NUM-1 

IF(NUM .EO. 0) GO TO 240 
DO 210 L=1,NUM 

READ (NRTAPE) TID,LN ,IEOTCK 

NERROR = 5 

IF (lEOTCK .EQ, 3HE0T) GO TO 997 
210 READ (NRTAPE) OUM 
GO TO 240 

220 BACKSPACE NRTAPE 
GO TO 240 
225 REWIND NRTAPE 
NUM = (-Nl-1)*2 
IF (NUM .FC. 0) GO TO 240 
00 230 L=1,NUM 
230 READ (NRTAPE) DUM 

24', IFdRFMRKd) .NE. 6H ) GC TO 250 

RFAD(NRTAPE) TID , LN ,DUM ,IPEMR K ( 1 ) ,ANAM 
NERR0R=6 

IF(LN+NI .NE. 0) GO TO 999 
NERR0R=7 

IF(ANAM ,NE. ANAME) GO TO 999 
BACKSPACE NRTAPE 

250 CALL PTAPE ( IREMRK ( 1 ), ANAME, lA, NR ,NC ,KR,KC , NRTAPE ) 

WRITE (NOT, 2006) NR,NC 
NLINE=NLINE+2 
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IF (N2.GT.O) CALL WRITAN < lA ,NR,NC ,ANAME ,KR» 

'c TAPE WRITING SECTION. 

300 IF (NWTAPE.LE.O) GO TO 400 

IF (IZl .fO. 1H$I CALL INTAPE (NWTAPE,IZ2I 

IF (IZ2 .EQ. 6HREWIND) REWIND NWTAPE 
CALL WTAPE ( lA tNR.'JC ,ANAME *KR, NWTAPE ) 

IF (IZ2 .EQ. 4HLISTI CALL LTAPE (NWTAPE) 

C 

400 WRITE (N0T»2005) 

NLINF=NLINE+2 

RETURN 

C 

997 CALL LTAPE (NRTAPEI 
GO TO 999 

998 WRITE (NOT, 2004) I,JS,IX 

999 CALL ZZBOMB (6HREADAN ,NERROR ) 

END 
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SUBROUTINE PEADIM UA ,NR,NC ,KR ,KC ) 

DIMENSION lAIKP,! , IX (I4J , IREMRKI9I 
COMMON / LLINE/ NLINE fMAXLlNf MINI 
DATA NIT, NOT/5,6/ 

READ MATRIX OF INTEGER NUMBERS FROM CARDS OR TAPE AND PRINT IT. WRITE 
MATRIX ON TAPE IF SO INDICATED (BY HAVING THE WRITE-TAPC NUMBER IN 
COLUMNS 70-80). 

THE EXPLANATION OF FORMATS USED BELOW IS ... 

A - DENOTES ANY KEY PUNCH SYMBOL. (EG, AI/*C). 

I - DENOTES AN INTEGER NUMBER- (EG, 436). 

CARD INPUT ♦♦♦♦ 

FIRST CARO - MATRIX NAME, NUMBER OF ROWS, NUMBER OF COLUMNS 
WITH A6,I4,I5 FORMAT. 

- REMARKS IN COLUMNS 16-69. A-TYPE FORMAT. 

- $ IN COLUMN 72 FOR WPITE-TAPE INITIALIZATION. 

- WRITE-TAPE CONTROL IN COLUMNS 73-78. MAY BE OR 

THE WORDS REWIND OP LIS". OP (WHEN $ IN COLUMN 72) 

THE WRITE-TAPE-ID (EG, TI234). 

- WRITE-TAPE NUMBER IN COLUMNS 79-80. (EG, 21). 

MIDDLE CARDS - DATA WITH FORMAT (215, 1415). 

- 1-ST 15 IS THE ROW NUMBER. 

- 2-ND 15 IS the col NUMBER OF THE NEXT 15 FIELD. 

- NEXT 1415 APE ELEMENTS OF THE MATRIX. 

LAST CARD - TEN ZEROS IN COLUMNS 1-10. 

tape input 

ONE CARD - MATRIX NAME, ZERO OR MINUS THE LOCATION NUMBER OF MATRIX 
C ON READ-TAPE, READ-TAPE NUMBER (IF MINUS. NO PRINTOUT), 

C MATRIX RUN NUMBER WITH A6,I4,I5,A6 FORMAT. 

C - RFAD-TAPE CONTROL IN COLUMNS 22-27.- MAY BE BLANK, OR THE 

C WORDS REWIND OR LIST. 

c - REMARKS IN COLUMNS 28-69. A-TYPE FORMAT. 

C - $ IN COLUMN 72 FOR WRITr-TAPE INITIALIZATION. 

C - WRITE-TAPE CONTROL IN COLUMNS 73-78. MAY BE BLANK, OR 

C THE WORDS REWIND OR LIST, OR (WHEN $ IN COLUMN 72? 

C the WRITE-TAPE-ID (EG, T1234). 

C - WRITE-TAPE NUMncR IN COLUMNS 7P-80. (EG, 21). 

C CALLS FORMA SUBROUTINES INTAPE ,LTAPE ,PAGEHD,RTAPE,WR ITIM ,WTAPE ,ZZBOMB . 
C CODED BY PF HRUDA- JULY 1968. 

C MODIFIED FOR CONTRACT NAS8-25922, OCTOBER 1970. 

C MODIFIED BY JOHN ADMfRt ♦NASA* SEPT 1973 
C LAST REVISION BY RL WOHLEN. APRIL 1976 <- 
C 

C SUBROUT INF ARGUMFNT5 

C lA = OUTPUT MATRIX READ FROM CARDS OR TAPE, 
t NR = OUTPUT NUMBER OF ROWS IN MATRIX lA . 

C NC - OUTPUT NUMBER OF COLS IN MATRIX lA. 

C KR = INPUT ROW DIMENSION OF +A IN CALLING PROGRAM. 

C KC = INPUT COL DIMENSION OF lA IN CALLING PROGRAM, 

t NERROR EXPLANATION 

C I 5= ROW SIZE EXCEEDS ROW DIMENSION OR 
S COLUMN SIZE rXCEFDS COLUMN DIMENSION, 

C 2 ~ ROW OR COLUMN VALUE OF ELEMENT EXCEEDS MATRIX SIZE. 

C 3 s data on card past matrix column SIZE. 

C 4 s LOCATION ON TAPE PAST END-OF-TAPE MARK. 
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r = LOCATION ON TAPE PAST END-OF-TAPE MARK. 


1001 FORMAT (A6,\4tI5f9A6, 2XAl,A6tI2) 

1002 FORMAT (1615) 

2001 FORMAT (//27H CARD INPUT INTEGER MATRIX A6, 2X IH ( 14, 2H X I4,2H ) 

♦ 2X 9A6,2X A1,A6,I4//) 

2002 FORMAT (//27H CARD INPUT INTEGER MATRIX A6, 2X IH ( 14, 2H X 14, 2H I 

* 3X 9HC0NTINJED //) 

2003 FORMAT (// IX A6, 14, 15 ,5X 9A6,2X A1,A6,I4) 

2004 FORMAT (IX 1615) 

2005 FORMAT (1 5H0END OF RE '‘DIM.) 

2006 FORMAT (25H0SIZE OF MATRIX READ IS (I4,2H X I4,2H ) ) 

2007 F0RMAT(/,1X,123(1H-)) 

READ IN HEADER CARD. 

READ (NIT, 1001) ANAME ,N1,N2,1REMRK, 17.1, IZ2,NWTAPE 
NR = N1 
NC = N2 

IF(Nl .GT. 0) GO TO 50 
IF(MINI .NF. 4HMINI) GO TO 40 
IF(NLINE .LE. 5) GO TO 40 
IF(NLINE+9 .GT. MAXLIW) CO TO 40 
WRITE(NnT,2007) 

NLlNE=NLINE+2 
GO TO 200 
40 CALL PAGEHD 
GO TO 200 

50 IF(MINI .NE. 4HMINI) GU TO 60 

IF(NLINE .LE. 5 .OR. NLINE .GE. MAXLIN) GO TO 60 
NBC=NC/14 

IF(14*NPC .NE. NC) NBC=NBC+1 
NN=o+NRTNBC 

IF(NN +NLINE .GT. MAXI IN) GO TO 60 
WRITE(NnT,?007) 

NLIME=NLINE+2 
GO TO 70 
60 CALL PAGEHD 
70 CONTINUE 

CARD READING SECTION. 

WRITE (NOT, 2001) ANAME,NR ,NC , IREMRK , IZl ,IZ2 ,NWTAPE 
NLINE=NLINE>5 

'■‘ERROR = 1 

IF (NR.GT.KR .OR. NC.GT.KC) GO TO 99 ' 
on 105 1 = 1, NR 
DO 105 J=1,NC 
105 IA(I,J) = 0 
110 READ (NIT, 1002) I,JS,IX 

IF (I.EQ.O .AND. JS.EO.O) GO TO 300 

NERRCK = 2 

IF (I.LE.O .CR. I.GT.NR .OR. JS.LE.O .OR. JS.GT.NC) GO TO 998 
JE = JS-H3 

IF (JE.LE.NC) GO TO 115 
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JX = NC-JS.+2 

NEP.ROR = 3 

DO 112 J=JX,1A 

112 IF (IXIJI .NE. 01 GO TO 998 
JF = NC 
115 N = 0 

00 120 J=JStJE 
N = N+1 

120 IACI*JI = 1X<N» 

IF(NLINF+1 .LE. MAXLINI GO TO 125 
CALI PAGEHO 

WRITE (NOT, 2002 » ANAME,NR,NC 
NLINE=NLINE+5 

125 WRITE (NOT, 20041 I , JS , ( lA ( I , J ) , J=JS , JE» 

NLINE=NLINE-H 
GO TO 110 

TAPE READING SECTION. 

200 WRITE (NOT, 2003) ANAME,N1,N2, IREMRK ,IZI ,IZ2,NWTAPE 
NLINE=NLINF+3 
NRTAPE = IABS(N2) 

IF (IREMRK (2) .EG. oHREWINOI REWIND NRTAPE 
IF (IREMPK(2) .EQ. ^LIST) CALL LTaPE (NRTAPE) 

IF (Nl-EQ.O) GO TO 250 
C POSITION NRTAPE. 

READ (NRTAPE) TTO,LN ,IEOTCK 
NUM - LN+Nl 
IF (NUM) 205,220,225 

205 NERROR = 4 

IF (lEOTCK .EG. 3HEOT) GO TO 997 
READ (NRTAPE) DUM 
NUM = -NUM-1 

IF(NUM .EQ. 0) GO TO 240 
DO 210 L=1,NUM 

READ (NRTAPE) TID, LN , I EOTCK 

NERROR = 5 

IF (IFOTCK .EC. 3HE0T) GO TO 997 
210 READ (NRTAPE) DUM 
GO 10 240 

220 BACKSPACE NRTAPE 
GO TO 240 
225 REWIND NRTAPE 
NUM = {-Nl-1)*2 
IF (NUM .EC. 0) GO TO 240 
DO 230 L=1,NUM 
230 READ (NRTAPE) DUM 

240 IFdRFMRKd) .NE . 6H ) GO TO 250 

PEAD(NRTAPE) TID , LN , DUM , IREMRK ( 1 ) ,ANAM 
NERROR-6 

IF(LN+N1 .NE. C) GO TO 999 
NERR0R=7 

IF (AN AM .NF. ANAME) GO TO 999 
BACKSPACE NRTAPE 

250 CALL RTAPE ( IREMRK (1 ), ANAME, lA, NR, NC ,KR,KC, NRTAPE) 

WRITE (NOT, 2006) NR ,NC 
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NLINE=NLlNE+2 

IF <N2.GT.0I CALL WRITIM ( IA,NR,NC,ANAME,KR» 

TAPE WRITING SECTION. 

300 IF (NWTAPE.LE.O) GO TO AOO 

IF IIZI .FO. 1H$) CALL INTAPE (NWTAPE,IZ2I 

IF (122 .EQ. 6HREWIND1 REWIND NWTAPE 
CALL WTAPF ( lA, NR, NC ,ANAME ,KR, NWTAPE ) 

IF (122 .EQ. AHLISTI CALL LTAPE (NWTAPE I 
C 

AOO WRITE (NOT, 20031 
NLINE=NLINE>2 
RETURN 
C 

997 CALL LTAPE (NRTAPEI 
GO TO 99<) 

998 WRITE (N0T,200Al I,JS,IX 

999 CALL ZZBON.B (6HREADIM,NERR0R) 

END 
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SUPROIITIK'E PFADO I A, NR,NC»KR *KC I 
DIWENSICN AIKR,1I ,X(3I,IREMRK(9I 
f'\TA NIT, NOT/5 *6/ 

READ matrix OF OCTAL NUMBERS FROM CARDS (PUNCHED BY SUBROUTINE 
PUNCHOI AND PRINT IT SIDE BY SIDE IN OCTAL AND DECIMAL. 

THE EXPLANATION OF FORMATS USED EFLCW IS ... 

A - DENOTES ANY KEY PUNCH SYMBOL- (EG, A1/*C). 

1 - DENOTES AN INTEGER NUMEER. (EG, 4361. 

O - DrNCTFS AN OCTAL NUMBER. 

**** CAPO INPUT ♦♦♦♦ 

FIRST CARD - MATRIX NAME, NUMBER OF ROWS, NUMBER OF COLUMNS 
WITH A6,I4,I5 format. 

- REMARKS IN COLUMNS lb~b^, A-TYPE FORMAT. 

MIDDLE CAROS - DATA WITH FORMAT (215,3 (3X, 01211 . 

- 1-ST 15 IS THE ROW NUMBER. 

- 2-ND 15 IS THE COL NUMBER OF THE NEXT 012 FIELD. 

- NEXT 3 012 ARE THE ELEMENTS OF THE MATRIX. 

LAST CARD - TEN ZEROS IN COLUMNS 1-10. 

CALLS FORMA SUBROUTINES PAGEHD ,Z ZBOMB . 

CODED BY CHRIS CHASE. MARCH 1969. 

MODIFIED FOR CONTRACT NAS8-25922, OCTOBER 1970- 
LAST REVISION BY RL WCHLEN. APRIL 1976- 


SUBROUTINE ARGUMENTS 

MATRIX READ FROM CAROS. 

NUMBER OF ROWS IN MATRIX A. 

NUMBER OF COLS IN MATRIX A. 

ROW DIMENSION OF A IN CALLING PROGRAM. 
COL DIMENSION OF A IN CALLING PROGRAM. 


A 

= OUTPUT 

NR 

OUTPUT 

NC 

- OUTPUT 

KP 

INPUT 

KC 

= INPUT 


NEPROR EXPLANATION 

1 = ROW SIZE EXCEEDS ROW DIMENSION OR 

COLUMN SIZE EXCEEDS COLUMN DIMENSION- 

2 = ROW OR COLUMN VALUE OF ELEMENT EXCEEDS MATRIX SIZE- 

3 = data on CARD PAST MATRIX COLUMN SIZE. 


1001 FORMAT 

1002 FORMAT 

2001 FORMAT 
♦ 

2002 FORMAT 
♦ 

2014 FORMAT 
2024 FORMAT 
2034 FORMAT 
2005 FCRKAT 


(A6,I4,15,9A6) 

(2I5,3(3X,012) ) 

(//19H CARD INPUT MATRIX A6, 2X 1H( 14, 2H X 14, 2H ) 
2X PA6//) 

(//1«H CARD INPUT MATRIX A6, 2X 1H( 14, 2H X 14, 2H } 
3X OH CONTINUED //I 

(IX 215, 3X,C12, 35X, 2X,1PF10.3 ) 

(IX 2I5,?(3X,012I,20X,2(?X,1PF10.? )l 
(IX 215, 3(3X, 0121, 5X,3(2X,1P£10.3I) 

(14H0L ND OF RE ADO. ) 


READ IN HEADER CARO. 

READ (NIT, icon ANAME ,NR,NC , IREMRK 
CALL PAGEHD 


WRITE (NOT, 2001 1 ANAME, NR, NC, IREMRK 


IF (NR.GT.KR -OR. NC-GT.KC) GO TO 999 


NERROR = 1 
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NLINE = 0 
DO 105 1=1, NR 
DO 105 J=1,NC 
105 A(I,JJ = O. 

110 READ CNIT, 10021 1,J$,X 

IF (I.EO.O .AND. JS.EQ.Ol GO TC AOO 

NERROR = 2 

IF (I.LE.O .OR. I.GT.NR .OR. JS.LE.C .OR. JS.GT.NCJ GO TO 996 
JE = JS+2 

IF {JF.LE.NCl GO TO 115 
JX = NC-JS+2 

NERROR = 3 

DO 112 J=JX,3 

112 IF (XtJ) .NE. 0.1 GO TO 998 
JE = NC 
115 N = 0 

DO 120 J=JS,JE 
N = N+1 

120 A(I,J» = X!N» 

NLINE = NLINE+1 

IF (NLINE .LE. 47) GO TC 125 

CALL PAGEHD 

WRITE (NOT, 2002) ANAME,NR,NC 
NLINE = 1 
125 NF = JE+l-JS 

IF (NF.EQ.l) WRITE(NOT,2014)I,JS,(A(I,J),J=JS,JE),(A(I,J),J=JS,JE) 
IF (NF.EQ.2) WPITE(N0T,2024)I,JS, ( A (1 , J ) , J=JS , JE ) , ( A ( I , J ) , J=JS, JE ) 
IF (NF.EQ.3) WRITE(NOT,2034)I,JS,(A(I,J),J=JS,JE) ,(A(I ,J) ,J=JS,JE) 
GO TO 110 

400 WRITE (NOT, 2005) 

RETURN 

998 WRITE (NOT, 2034) I,JS,X,X 

999 CALL ZZBOMB (6HREA0C , NERROR) 

END 
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SUPRC?UTINE REVAOO ( ALPHA* A, IVEC , JVC C,Z*NR A,NC A »NRZ,NCZ tKRA,KRZ ) 
DIMENSION A(KRA*1), IVEC(D* JVEC(l), Z(KRZ*1I 

REARRANGE AND ADO ROWS AND COLUMNS OF ALPHA ♦ MATRIX A INTO 
MATRIX Z. 

BE SURE MATRIX 2 IS DEFINED PEFORE CALLING THIS SUBROUTINE. FOR 
EXAMPLE, CALL ZERC TO CLEAR MATRIX Z. 

CALLS FORMA SUPOO’JTINE ZZBOMB. 

COOED BY RF HRUDA. JULY 1965. 

LAST REVISION BY WA BENFIELD. MARCH 1976. 

SUBROUTINE ARGUMENTS 

ALPHA = INPUT SCALAR THAT MULTIPLIES MATRIX A. 

A = INPUT MATRIX TO PE ARRANGED AND AOOEO. SIZE INP.A,NCA) . 

IVEC = INPUT VECTOR. SIZE(NRA). 

IVEC(I»=ROW POSITION OF A (ROW I) IN Z. 

IF IVECdl IS PLUS ,Z=ZIROW IVEC( 1 1 l♦ALPHA♦A(ROW II. 

IF IVEC (I I IS MINUS, Z=Z (ROW IVEC{ 1 1 )-ALPHA*A(ROW II. 

IF IVEC(I) IS ZERO , A(ROW II IS OMITTED IN Z. 

JVEC = INPUT VECTOR. SIZE(NCA|. 

^JVECI JI^GL POSITION OF A (COL Jl IN Z. 

IF JVEC(J) IS PLUS ,Z=Z(COL JVEC ( Jl l + ALPHA^A (COL Jl. 

IF JVEC(JI IS MINUS, Z=Z (COL JVEC( Jl l-ALPHA=FA (COL Jl. 

IF JVEC(J| IS ZERO , A(CPL Jl IS OMITTED IN Z. 

Z INPUT/OUTPUT MATRIX TO WHICH ALPHA*A IS ADDED. SIZE(NRZ,NCZI . 

NRA = INPUT NUMBER OF ROWS IN MATRIX A. 

NCA = INPUT NUMBER OF COLS IN MATRIX A. 

C NRZ = INPUT NUMBER OF ROWS IN MATRIX Z. 

C NCZ = INPUT NUMBER OF COLS IN MATRIX Z. 

C KRA = INPUT ROW DIMENSION OF A IN CALLING PROGRAM. 

C KRZ = INPUT ROW DIMENSION OF Z IN CALLING PROGRAM. 

C 

C NERROP EXPLANATION 

C .1 = ROW LOCATION OUTSIDE MATRIX Z. 

C " 2 = COLUMN LOCATION OUTSIDE MATRIX Z. 

C 

DO 30 IA=1,NRA 

IZ = lABSdVECdAll 

IF (IZ .EC*. 01 GO TO 30 

NERROR = 1 

IF (IZ .GT. NRZ) GO TO 999 
DO 25 JA=1,NCA 
JZ = TABS (JVEC( JA Jl 
IF (JZ .EQ. 0) GO TO 25 

NERROR - 2 

IF (JZ .GT. NCZ) GO TO 999 
STGN = +1. 

IF dVFC( lA I.LT.O .AND. JVEC ( JA ) .GT.O .OR. 

* IVFC( lAl.GT.O .AND. J VEC ( JA I .LT .0 ) S1GN=-1. 

Z(IZ,J2) = ZllZtJZ) + SIGN»ALPHA»A( IA,JAI 
25 CONTINUE 
30 CONTINUE 
RETURN 


999 CALL ZZBOMB ( 6HRE VADD , NERROR) 
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END 



UOOUUUUUOUUOUUUUOUUUCiU O ’J u 


REVIJ 


1 / 2 


SUBROUTINE REVIJ ( AZ t I VECt JVEC ,NRA ,NCA*NR2 fNCZ t KRA2) 
DIMENSION AZ(KRAZ,1 ) « IVEC ( 1) • JVEC (1 ) 

COMMON / LWRKVl / V(500J 


REARRANGE AND ADD ROWS AND COLUMNS OF MATRIX (A) INTO 
MATRIX (2). BOTH MATRIX (A) AND (Z) SHARE THE SAME STORAGE. 
MATRIX tZ) IS SET EQUAL TO ZERO INITIALLY BY THE ROUTINE. 
CALLS FORMA ROUTINE ZZBCMB. 

CODED BY JOHN ADMIRE =«'NASA* AUG 1973. 


AZ 

AZ 

IVEC 


JVEC 


NRA 

NCA 

NRZ 

NCZ 

KRAZ 


SUBROUTINE ARGUMENTS 

INPUT MATRIX (A) TO BE ARRANGED AND ADDED TO MATRIX (Z). 

OUTPUT MATRIX (2) RESULT OF ARRANGING AND ADDING (A) TO (21. 

INPUT INTEGER VECTOR (NRA) 

ABS(IVEC(in = ROW OF (2) TO WHICH ROW I OF (A) IS ADDED. 
IFdVECd) NEGATIVE) THE SIGNS IN ROW I OF (A) ARE 

CHANGED BEFORE BEING ADDED INTO (Z). 
IFdVEC(I) ZERO) THE ROW I IN (A) IS OMITTED FROM (Z). 

INPUT INTFGEO VECTOR (NCA) 

ABS(JVeC(J) )=CCLUMN OF (Z) TO WHICH COLUMN J OF (A) IS ADDED 
IF(JV'Fr(J) NEGATIVE) THE SIGNS IN COLUMN J OF (A) ARE 

CHANGED BEFORE BEING ADDED INTO (Z). 
IF(JVEC(J) ZERO) THE COLUMN J IN (A) IS OMITTED FROM (Z) 

INPUT NUMBER OF ROWS IN MATRIX (A) 

INPUT NUMBER OF COLUMNS IN MATRIX (A) 

OUTPUT NUMBER OF ROWS IN MATRIX 12) 

OUTPUT NUMBER OF COLUMNS IN MATRIX (Z) 

INPUT ROW D1MENSIC5N OF AZ IN CALLING PROGRAM 


NERROR=l 

IF(KRAZ .GT. 500 .OR. NRA .GT. KRAZ .OR. NCA .GT. 500) GO TO 999 

NRZ = 0 

NCZ=C 

DO 10 1=1, NPA 

IFdAES (IVEC(I) ) .GT. NRZ) NRZ=IABS (IVECd) ) 

10 continue 

DO ?0 J=1 ,NCA 

IF(IARS(JVFC(J)) .GT. NCZ) NCZ=IABS( JVEC( J) ) 

20 CONTINUE 
NERPOF=? 

IF (NRZ .GT, KRAZ .OR, NCZ .GT. 500) GO TO 999 

MAXI=NPA 

MAX J=NCA 

IF(NRZ .GT. NRA) MAXI=NRZ 
IF(NCZ .GT, NCA) MAXJ=NCZ 
DO 70 J=1,NCA 
DO 30 1=1, NR A 
30 V(I»=AZ(I,J) 

DC AC 1 = 1 ,MAXI 
AO AZ (1,J)=0. 

DO 70 1 = 1, NRA 
II = IABS ( ivrc( 1 ) ) 
iFdvEC (I nr>o,7o,6o 
50 AZ{II,J)=AZ(II,J)-V(I ) 

GO TO 70 
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60 A2(II,J)=AZ(II,JI+V(I I 
70 CONTINUF 

DO 120 1=1, NRZ 
DP 80 J=1,NCA 
80 V<J|=A2(I,J> 

DO 90 J=1 ,MAXJ 
90 A2(I,J)=0. 

DO 120 J=1,NCA 
JJ=IABSJJVECIJ) > 
IF(JVFC(J))100,120,110 
100 A2tI,JJ)=A2(I,JJ)~V<J) 

GO TO 1?0 

110 AZ(I,JJ)=A21I,JJ)+V(J) 

120 CONTINUE 
RETURN 

999 CALL 2ZB0MB(6HREVIJ ,NERROR) 
END 



ROWMLT 


SUBROUTINE ROWMLT ( AVEC ,B f I tNR tNC tKR ) 

DIMENSION AVEC(l), B(KR,1), Z(KR,1» 

C 

C MULTIPLY EACH ELEMENT IN ROW(I) OF MATRIX B BY ELEMENTCIJ OF 
C VECTOR AVEC. 

C MATRICES B,Z MAY SHARE SAME CORE LOCATIONS. 

C CODED BY RL WOHLEN. FEBRUARY 1965. 

C 

C SUBROUTINE ARGUMENTS 

C AVEC = INPUT VECTOR. SIZE (NR). 

C B = INPUT MATRIX. SIZE(NR.NC». 

C Z = OUTPUT RESULT MATRIX. SIZE(NR,NC). 

C NR = INPUT NUMBER OF ROWS IN MATRICES B,Z. ELEMENTS IN VECTOR AVEC. 

C NC = INPUT NUMBER OF COLS IN MATRICES B,Z. 

C KR = INPUT ROW DIMENSION OF BtZ IN CALLING PROGRAM. 

C 

DO 10 1=1, NR 
DO 10 J=1,NC 

10 Z(1,J) = AVEC(I) B(I,J) 

RETURN 

END 
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C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

p 


c 


SUBROUTINE RTAPE ( lARUNO.I ANAME , A,NRA,NCAt KR.KC.NTAPEI 
DIMENSION A(KR,1) 

DATA NIT,NGT/5,6/ 

READ MATRIX A FROM TAPE BY IDENTIFICATION OF lARUNO, lANAME. 

CALLS FORMA SUBROUTINES LTAPE ♦ PAGEHD iZZBOMB. 

CODED BY WA FFNFIELD. JUNE 1966. 

REVISED BY RF HRUDA . JULY 1968. 

REVISED BY R A PHILIPPUS. APRIL 1969. 

MODIFIED FOR CONTRACT NAS8-25922, OCTOBER 1970. 

SUBROUTINE ARGUMENTS 

lARUNO = INPUT RUN NUMBER OF MATRIX A. (A6 FORMAT). 
lANAME = INPUT MATRIX IDENTIFICATION. (A6 FORMAT). 

A = OUTPUT MATRIX READ FROM TAPE- SIZE(NRA,NCA) . 

NR A = OUTPUT NUMBER OF ROWS OF MATRIX A. WILL BE READ FROM TAPE. 

NCA = OUTPUT NUMBER OF COLS OF MATRIX A- WILL PE READ FROM TAPE. 

KR = INPUT ROW DIMENSION OF A IN CALLING PROGRAM. 

KC = INPUT COL DIMENSION OF A IN CALLING PROGRAM. 

NTAPE = INPUT NUMBER OF TAPE. (E-G. 10). 

NERROR EXPLANATION 

1 = MATRIX REQUESTED IS NOT DENSE. 

2 = ROW OP COLUMN SIZE EXCEEDS DIMENSION SIZE- 

3 = MATRIX/RUNNO REQUESTED NOT FOUND ON TAPE. 

3001 FORMAT (29H1RTAPE CANNOT FIND RUNNO = A6 / 

* 2 IX 8HANAME = A6 / 29X 6H ) 


NTIMF = 0 

C SEARCH TAPE FOR CORRECT HEADING. 

5 READ <NTAPE) TAPE ID ,LN, IE OTCK ,ITRUNO* ITNAME ,NR A*NCA .DATE ♦ ITYPE.NNZ 
IF (ITRUNO .EG. lARUNO .AND. ITNAME .EQ. lANAME) GO TO lO 
IF (lEOTCK .EG. 3HE0T) GO TO 20 
READ (NTAPE) OUM 
GO TO 5 


MATRIX HAS BEEN FOUND. 

10 NERROR = 1 

IF (ITYPE .NE. 5HDENSE .AND. NNZ .NE. 0) GO TO 999 

NERROR = 2 

IF (NRA.GT.KR .OR. NCA.GT.KC) GO TO 999 
READ (NTAPE) ( ( A ( I , J ) , 1=1 , NR a) t J=1 .NCA ) 

RETURN 

.. MATRIX CANNOT BE FOUND. SEARCH TAPE ONCE MORE. 

20 NTIME = NTIME+1 

NERROR = 3 

IF (NTIMF .FO. 2) GO TO 998 
REWIND NTAPE 
GO TO 5 


998 WRITE (NOT, 3001) lARUNO, lANAME 
CALL LTAPF (NTAPE) 

999 CALL ZZBOMB (fchRTAPE , NERROR) 
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END 
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SUBROUTINE RWND (NTAPE ) 

REWIND tape. 

CODED BY RL WOHLEN. MARCH 1976. 

SUBROUTINE ARGUMENT (INPUT) 
NTAPE = NUMBER OF TAPE. (EG 10). 

REW^.vO NTAPE 

RETURN 

END 
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SUBROaTINf SIGMA (ZtNtKR) 

DIMENSION Z(KRtl) 

GENERATE A MATRIX OF ONES ON AND BELOW THE DIAGONAL. 

CODED BY RL WOHLEN. FEB 1965. 

SUBROUTINF ARGUMENTS 

2 » OUTPUT MATRIX GENERATED. SI2E(N,N). 

N = I^''>UT SIZE OF MATRIX Z (SQUARE). 

KR = INPUT ROW DIMENSION OF MATRIX Z IN CALLING -PROGRAM. 

DO 10 1=1 »N 
DO 10 J=I»N 
2(1, J) = 0.0 
10 Z(J,I) = 1.0 
RETURN 
END 
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SUBROUTIKt SKPR (N;aPE,NRECI 

SKIP \RFC LCGICAL RECGPOS 'FORWARD OR BACKWARD) ON NTAPE. 

COOED BY RL WCHLEN. MARCH 1976. 

SUBROUTINE ARGUMENTS (ALL INPUT) 

NTAPE = NUMEER OF TAPE. (EG 10). 

NREC - NUMBER OF LCtGICAL RECORDS TO SKIP (FORWARD OR BACKWARD). 

IF (NREC .EC. O# RETURN 
IF (NREC .LT. C) GO TO 20 
00 15 IREC=1*NREC 
15 READ (NTAPE) 

RETURN 

20 LREC = lAES(NREC) 

DC 25 IREC=1,LPEC 
?5 BACKSPACE NTaPE 
RETURN 
END 
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SUBROUTINE SWEtl (AfPtZ.N.KRJ 
DIMENSION A{KR,1),8(1 I.ZUI 
DATA TGL/l.E-15/ 

C 

C SOLUTION OF LINEAR SIMULTANEOUS ALGEBRAIC EQUATIONS, A*2 = B. 

C GAUSS ELIMINATION METHOD. FORWARD SOLUTION TRANSFORMS ORIGINAL SYSTEM 
C INTO T»?IANGULAR FORM. BACK SOLUTION THEN GIVES RESULT. 

C LARGEST PIVOTAL DIVISOR IS USED TO AVOID DIVISION BY SMALL NUMBERS. 

C the rows are INTERCHANGED WHEN NECESSARY TC ACCOMPLISH THIS. 

C IF NO PIVOT CAN BF Fi. MO EXCFEDINC l.E-15, THE MATRIX IS CONSIDERED 
C SINGULAR AND THF PROGRAM STOPPED. 

c Calls ^orma sufroutinf zzbomb. 

C DEVELOPED BY CARL PDDLFY. AUGUST I960. 

C LAST REVISION EY KA bENFlELD. MARCH 1976. 

C 

C SUBROUTINE ARGUMENTS 

C A = INPUT SQUARE MATRIX OF COEFFICIENTS. SI2F(N,N». ♦DESTROYED* 

C B = INPUT RIGHT HAND SIDE VECTOR . SI2E(N). *DESTROYEO* 

C 2 = OUTPUT RESULT VECTOR. SIZE(N). 

C N = INPUI NUMBER OF EQUATIONS. 

C KR = INPUT ROW DIMENSION OF A IN CALLING PROGRAM. 

C 

C NERFOR EXPLANATION 

C 1 = MATRIX IS NCN-POSITIVE DEFINITE FOR SIZE = 1. 

C 2 = MATRIX IS NON-POSITIVE DEFINITE. 

C 

IF (N .GT. IJ GO TO 5 

N ERROR = 1 

IF »AES(M1,1)I .LE. lOL) GO TO 999 
Z(l) = 6<1|/AC1,1I 
RETURN 
C 

C FORWARD SOLUTION. 

5 DO 25 L=1 ,N 
AMAX = TOL 
DC 10 I=L,N 

IF (ABS<A(I,H) .LT. ABS(AMAXM GO TO 10 
AMAX - A( I,L) 

IMAX = I 
10 CONTINUE 

NERROR 2 

IF (ABS(AMAXJ .LE. TOLI GO 70 999 
00 15 J=L,N 
SAVE - A(IMAX,J) 

ACIMAXtJ) - AlLtJI 
15 AM ,J) = SAVE /AMAX 
S^VF = B(IMAX) 

BfIMAXI = F(L» 

B(L) = SAVE /AMAX 

IF (L .EQ. N| GO TO 40 

LPl = L ♦ 1 

DO ?5 I=LP1,N 

DO 20 J-LP1,N 

20 A(I,J1 = - A(I,L l*A<L, J» 

25 B(I) = b(l) - A(I,U*E(L) 
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BACK SCLUTIPN. 

40 2(N) = &{N) 

NMl = N - 1 
DO 45 L=1,NM1 
I = N - L 
zdi = eu) 
iPi = i+i 
DC 45 J=IP1,N 

45 Z(I) = Zdl - A(I»Jt=^Z<Jl 
RETURN 

999 CALL Z2B0MB (6HSME01 ,NERROR| 
END 
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SUBROUTINE SREfU (A ,R ,T,N,NR, IFT,KART| 
DIMENSION A«KART,1|,R(KART,1I ,TCKART,1| 
DATA EPS/1. E-15/ 


REDUCE STIFFNESS MATPIX (A I TO FORM REDUCED STIFFNESS MATRIX (R1 AND 
REDUCING TRANSFORMATION (TI. 

DEGREES OF FREEDOM TG BE REDUCED MUST BE POSITIONED LAST IN MATRIX A. 
MATPIX (A) SHOULD PE POSITIVE DEFINITE, SYMMETRIC. LOWER HALF OF 
MATRIX (A) IS USED. 

MATRIX (T) MAY BE A SCALAR ARGUMENT IF THE REDUCING TRANSFORMATION 
IS NOT FORMED. 

MATRICES (Al, (PI, AND (Tl MAY SHARE THE SAME CORE LOCATIONS IN ANY 
COMBINATIONS. POSSIBLE COMBINATIONS OF INPUT ARGUMENTS ARE SHOWN 
BELOW WITH THF RESULTING OUTPUT FROM THE SUBROUTINE. 

♦CALLING ARGUMENTS* ^RESULTING OUTPUT* 

CALL SPFOl (A,P,T,N,NR,1,KAPTI A=A, R=R , T=T 


CALL SREOl (A,A,T,N,NR,1,KAPT) A=R, T=T 

CALL SFFDI ( A, T, T ,N,NR, 1, KART I A=A, T=T 

CALL SREOl (A, A, A, N, NR, 1, KART) A=T 

CALL SREDl ( A ,R , A ,N ,MP , 1,KART I R=R, A=T 

CALL SRFDl ( A ,R , T ,N ,NR, 0, KART ) A=A, R=R 

CALL SREOl (A,A,T,N,NP,0,KART) A=R 

CALLS FORMA SUBROUTINE ZZBOMB. 

DEVELOPED BY CS BODLEY AND WA BENFIELD. OCTOBER 1971. 
LAST REVISION BY WA BENFIELD. MARCH 1976. 


C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 


SUBROUTINE 


A 

- 

INPUT 

R 


OUTPUT 

T 


OUTPUT 

N 

- 

INPUT 

NR 

= 

INPUT 

IFT 

- 

l^PUT 

KART 

— 

INPUT 


ARGUMENTS 

STIFFNESS MATRIX TO BE REDUCED. SIZEIN,N). 

REDUCED STIFFNESS MATRIX. SI2E(NR,NR). 

REDUCING TRANSFORMATION MATRIX. SIZE(N,NR). 

SI7E OF MATRIX A. 

SIZE OF REDUCED MATPIX R. 

=0, TRANSFORMATION MATRIX T WILL NOT EE CALCULATED AND 
T NEED NOT BE DIMENSIONED IN CALLING PROGRAM. 

-1, TRANSFORMATION MATRIX T WILL BE CALCULATED. 

ROW DIMENSION OF A,R,T IN CauLING PROGRAM. 


NEPROR EXPLANATION 
1 = MATRIX IS NON-POSITIVE DEFINITE. 


DO 5 1 = 1, N 
DO 5 J-1,I 
5 P(I,JI = A(I,J) 

NRPl = NR+1 

NERR0R=1 

CALCULATE oppuCFO STIFFNESS MATRIX. 

DC 10 L=NPP1,N 
K = N-L-^NRPl 
KMl = K-1 

IF (P(K,K) .LT. EPS) GO TO 999 
DO 10 1 = 1, KMl 
S = R(K,I )/R(K,K) 

DO 10 J=1,I 

10 R(1,J) = R(I,J) - S*R(K,J) 

DO 15 1 = 1, NR 



SREOl 


DC 15 J=I,NR 
15 R(I,J» = R(J*I) 

C 

C CALCULATE REDUCTIGN TRAMS FORMATION MATRIX. 
IF (IFT .EC. 01 RETURN 
DO 29 L=NRP1,N 
S = RIL,L) 

DO 25 K=1,NR 
25 R(L,K) = R(L,K)/S 

IF(L .GE. N) GO TO 29 
LPl = L+1 
00 27 I^LPl.N 
or* 27 J=1,NR 

27 R(I,J) R(I,J) - RTI,wl*R(L, J) 

29 CONTINUE 

DC 35 1=1, NR 
DO 32 J=1,NR 
32 TCI,J) = 0.0 
35 T(T,I) = l.C 
DO 45 I=NPP1,N 
DO ^5 J=1,NR 
45 T<I,J) = -R(I,J) 

RETURN 

C 

999 CALL ZZBOMb (6HSRED1 ,NERROR) 

END 
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SUPROUTINf SRED2 I A ,R ,T ,\SNR, IFT,KART J 
DIMENSION A(KART,1), R(KART,ll, T(KART,11 
data EPS/l.E-15/ 

REDUCE STIPE NESS MATRIX (Al TO FORM REDUCED STIFFNESS MATRIX (Rl AND 
REDUCING TRANSFORMATION (Tl. 

DEGREES OF F»tEDPM TO BE REDUCED MUST EE POSITIONED FIRST IN MATRIX (A). 
MATRIX (A) SHOULD BE POSITIVE DEFINITE. SYMMETRIC. UFPER HALF OF 
MATRIX (A) IS USED. 

MATRIX (7) MAY BE A SCALAR ARGUMENT IF THE REDUCING TRANSFORMATION 
IS NOT FORMED. 

matrices (A), (R), AND (Tl MAY SHARE THE SAME CORE LOCATIONS IN ANY 
COMBINATIONS. POSSIBLE COMBINATIONS OF INPUT ARGUMENTS ARE SHOWN 
BELOW WITH THE RESULTING OUTPUT FROM THE SUBROUTINE. 

’^'CALLING ARGUMENTS* ♦RESULTING OUTPUT* 

CALL SRED2 (A.F ,T,N,NR, l.KART I A=A, R=R. T=T 

CALL SRED2 (A.A.T.N.NR, l.KART ) A=R. T=T 

CALL SRED2 ( A .T.T.N.NP.I.KaRT I A=A. T=T 

CALL SRFD2 ( A , A A ,N ,NR, 1 .KART > A=T 

CALL SRE02 ( A ,R , A ,N ,N R , 1, KART ) R=R. A=T 

CALL S«^F02 (A.P.T.N.NP.O.KART) A-A. R = P 

CALL 5RED2 (A ,A,T ,N,NP .O.KAPT 1 A=P 

CALLS FORMA SUE ROUTINE Z260MF- 

DEVELOPED BY Cf BODLEY AND WA 6ENFIELD. JUNE 1972. 

LAST REVISION BY WA BLNFIELD. MARCH 1976. 

SUBROUTINE ARGUMENTS 

A = INPUT STIFFNESS MATRIX TO BE REDUCED. SIZE(N,NI. 

R = OUTPUT REDUCED STIFFNESS MATRIX. SIZE(NR.NR). 

T = OUTPUT REDUCING TRANSFORMATION MATRIX. SIZE(N.NR). 

N - INPUT SIZE OF MATRIX A. 

NR = INPUT SIZE OF REDUCED MATRIX R. 

IFT = INPUT =0, TRANSFORMATION MATRIX T WILL NOT BE CALCULATED AND 

T NEED NOT BE DIMENSIONED IN CALLING PROGRAM. 

-1. TRANSFORMATION MATRIX T WILL BE CALCULATED. 

KART = INPUT ROW DIMENSION OF A.R.T IN CALLING PROGRAM. 

NERROR EXPLANATION 
I = MATRIX IS NON-POSIIIVE DEFINITE. 

ND = N - NR 
DO 5 I^l.N 
DO b J=!,N 
5 P (I.J) = A(I.J) 

NDPl = NO+1 

C CALCULATE PFDUCEO STIFFNESS MATRIX. 

00 11 L-l.ND 

IF (APS(R(L,L)) .LT.EPS) GOTO 999 
IF (L .GE. N) GO TO 11 
LPl = L+1 
DO 10 I=LP1,N 
S = P.(LrI )/R(L.l 1 
DO 10 J=I.N 

Rd.j) = Rd.J) - S*R(L.J) 


NERR0R=1 
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10 CONTINUE 

11 CONTINUE 

IF (IFT .FQ. 0) GO TO 50 

CALCULATE REDUCTION TRANSFORMATION MATRIX. 
DO 20 L=1,ND 
S = R(L,L) 

DO 15 K=L,N 

15 R(L,K) = R(L,K)/S 
IF (L .:-C. 1) GO TO 20 
LMl = L-1 
LPl - L+1 
DO 16 1=1 ,LM1 
DO 16 J=LP1»N 

16 R(ItJ) = R(ItJ) “ R (1 »L)*R(L, J) 

20 CONTINUE 

DO 30 I=NDP1,N 
DO 29 J=1,NR 

29 T(I,J) = 0.0 
IMND = 1 - ND 

30 T( ItIMND) 1 .0 
50 DO 60 L=NP 1,N 

J = L - ND 

C STMMETRIZF R AND START IN 1,1 LOCATION. 

DO 65 K=NDP1,N 
I = K - NT 

IF (I .GI . J) GO TO 66 
R(I,J) = R(K,U 

GO TO 65 

66 R(1,J) = R(L,K) 

65 CONTINUE 

C START T IN 1,1 LOCATION. 

IF (IFT .EO. 0) GO TO 60 
DO 67 1=1 ,N0 

67 T(I,J) = -R(I,L) 

60 CONTINUE 

RETURN 

C 

999 CALL ZZBCMB (6HSRED2 ,NERRDR) 

END 
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SUBRCUTIKT SPED3 ( A, IV,R ,T ,N ,NR , IFT, KART | 

DiMfNSICN A(KART,1), R(KART,1I, T(KART,1|, IVCll 
COMMON /LWPKVl/ W(500) 

DATA EPS/1. E-15/ 

C 

C SUBROUTINE .C REDUCE MATRIX (A> TO FORM REDUCED STIFFNESS MATRIX (Rl 
C AND REDUCING TRANSFORMATION (T). 

C ROWS AND COLUMNS TO BE REDUCED OUT MAY BE ANYWHERE IN (A) AND ARE 
C SPECIFIED EY THE INTEGER VECTOR (IVI. 

C THE ORIGINAL NUMBER OF ROWS AND COLUMNS IN (Al APE THE SAME FOR (P ) 

C WITH ZERO ROW AND COLUMN ELEMENTS FOR THE REDUCED ROWS AND COLUMNS. 
C THE REDUCING TRANSFORMATION (T) LIKEWISE WILL BE SCUARE. 

C MATRIX (A) SHOULD PE POSITIVE DEFINITE, SYMMETRIC. 

C ALL OF MATRIX (A) IS USED. 

C MATRIX (T) MAY BE A SCALAR ARGUMENT IF THE REDUCING TRANSFORMATION 
C IS NOT FORMED. 

C MATRICES I Alt (R)t AND ( T) MAY SHARE THE SAME CORE LOCATIONS IN ANY 
C COMBINATIONS. POSSIBLE COMBINATIONS OF INPUT ARGUMENTS ARE SHOWN 
C BELOW WITH THE RESULTING OUTPUT FROM THE SUBROUTINE. 

C *CALL1NG ARGUMENT ST TRESULTING CUTPUTT 


C 

CALL 

SR ED 3 

( A , r V f R 

,T,N,NR,1,KAPTI 

A=A, 

R=P, 

T=T 

c 

CALL 

SRED3 

(A, IV, A 

,T,N,NP, 1,KART) 


A=R, 

T=T 

c 

CALL 

SRE03 

( A,IV,R 

, A, N, NR, I, KART) 


R=R, 

A=T 

c 

CALL 

SPED 3 

(A, TV, A 

,A,N,NR, 1,KAPT1 



A=T 

c 

CALL 

SR ED 3 

( A,IV,P 

,R ,N,NR, 1,KART) 

A=A 


R=T 

c 

CALL 

SPED? 

(A,IV,P 

,T ,N,NP,0,KAPT) 

A=A, 

P=R 


|: 

CALL 

SFE0 3 

(A, IV, A 

,T,N,NR,0,KAPT) 


A=R 



C CALLS FORMA SUBROUTINE ZZBOME. 

C DEVELOPED bY WA EEI.'FIELD. JANUARY 1974. 

C LAST REVISION PY KA RENFIELD. MARCH 1976. 

C 

C 5UEROUT1NF ARGUMENTS 

C A = INPUT STICENESS MATRIX TO EE REDUCED. SIZE(N,NI. 

C IV = INPUT INTFGEF ROW MATRIX CONTAINING THE ROW-COLUMN 

C LOCATIONS TO b£ REDUCED. SIZEINRI. 

C R = OUTPUT REDUCED STIF^^NESS MATRIX. S1ZF(N,N). 

C T = OUTPtiT REDUCING TRANSFORMATION MATRIX. SIZE(N,N). 

C N = INPUT SIZE OF MATRICES AtR,T. MAX=500. 

C NR = INPUT MJMEEP OF ROW-COLUMNS TO BE REDUCED. 

C IFT = INPUT =G. TP ANSECPMATjriN MATRIX T WILL NOT BE CALCULATED 

C AND T NEEF " PE DIMENSIONED IN CALLING PROGRAM. 

C =1, TRANSF-’PMA ' -N MATRIX T WILL BE CALCULATED. 

C KART = INPUT ROW DIMENSION OF A,R,T IN CALLING PROGRAM. 

C 

C NFKPOR FXPLANATION 

C 1 = ROW NUMBER IS NEGATIVE. 

C 2 = MATRIX IS NON-PCSITIVE DEFINITE. 

C 

DO 5 1 = 1, N 
DO 5 J=1,N 
5 R( I,J) = MI,J) 

DO 3b K=1 ,NR 
IR = 1V(K) 

NlRROR=l 

IF tIR .LE. 0) GO TO 999 
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NERR0R=2 

IF (RtlPflR) .LT, EPS) GO TO 999 
C R(IktlR) 

DO 10 J=1 fN 
10 R(IR»J) = P(IR»J)/C 
DO 30 1=1, N 

IF (I ,E0. IR) GO TO 30 
C = R(I,IP> 

DO 20 J=1,N 

20 R(I,J) = R(I,J) - C=*^R(IR,JI 
30 CONTINUE 
35 CONTINUE 
DC 90 1=1 ,N 
DO 37 K=1,N 
37 W(K) = R( I,K) 

DO 40 K = 1 ,NR 

IF (IV(K) .EQ. n GO TO 60 
40 CONTINUE 

IF (IFT .EO. 0) GO TO 90 
DC 50 J=1,N 
50 T(I,J) = 0.0 
T(i,n = 1.0 

GO TO 90 
60 DO 70 J=1,N 
R(J,I) = 0.0 
70 R(1,J) = C.C 

IF (IFT .EC. 0) GO TO 90 
DO lb J = 1,N 
75 T(1,J) = -W(J) 

T(I,I) = O.C 
90 CONTINUE 
RETURN 

999 CALL ZZbOMB (6hSRED3 ,NERROR) 

END 
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SUBROUTINE START 

COMMON /LSTART/IRUNN0,DATE,NPAGE,UNAME(3»,TITLE1I12I,T1TLE2(12) 

COMMON /LLINE /NLINE,MAXLIN,M1NI 
DATA NIT,N(jT/5t6/ 

EACH TIME THIS ROUTINE IS CALI ED THE COMPUTER IS INTEROGRATED TO 
OBTAIN THE DATE, TIME OF DAY, AND THE CPU TIME. TIME CF DAY AND CPU ARE 
PRINTED ON A NEW PAGE. NPAGE AND NLINE ARE THEN SET EQUAL TO ZERO. 

CARO 1 IS READ Nf=XT TO OBTAIN IRUNNO, MINI, AND UNAME. 

IF IRUNN0=^HSTC‘P T.iF PROGRAM IS STOPPFO AT THIS POINT. 

IF IRUNN0=6HRFTURN A RETURN IS MADE TO THE CALLING PROGRAM. 

IF IRUNNO IS NOT EQUAL TO STOP OR RETURN TWO ADDITIONAL CARDS ARE READ. 
CARO 2 IS READ NEXT FOR TITLEl. 

CARD 3 IS EFAD NEXT FOR TITLE2. 

LAST A RETURN IS MADE TO THE CALLING PROGRAM. 


CARD INPUT 
xRUNNO, MINI, UNAME 
TITLEl 
TITLE2 


FORMAT (A6,A4,3A6) 
FORMAT (12A6) 
FORMAT (12A6) 


IRUNNO 

DATF 

NPAGE 

UNAME 

TITLEl 

TITLE2 

NLINE 

MAXLIN 

MINI 


DEFINITIONS 
= RUN NUMBER 
= DATE 

- PAGE NUMBER 
= USERS NAME 

= FIRST TITLE 
= SECOND TITLE 
= LINE NUMBER 

= MAXIMUM NUMBER OF LINES PRINTED PER PAGE 

- PRINT OPTION (IF MINI'-^HMINI OTHER FORMA ROUTINES WILL 
ATTEMPT TO MINIMIZE THE NUMBER OF PAGES PRINTED BY PRINTING 
MORE THAN ONE SET OF DATA PER PAGE I 


MODIFIED AUG. 19?3 BY JOHN ADMIRE ’►NASA* 


1001 FORMAT (A6,AA,3A6I 

1002 FORMAT (12A6) 

2002 FORMAT (IHI 6(/) B5X lOHTIME SHEET / 38X 45(1H-) // 

* 3fX 30HCURRENT TIME OF DAY IN H,M,S = A 6 // 

♦ 38X 26HT0TAL CPTIME USED TO NOW = 15, °H SECONDS. // ) 

2003 FORMAT (36H1EN0 OF INPUT DATA HAS BEEN REACHED.) 

C 

CALL SCLOCK (PATE , TIME, ESEC ,E60SEC) 

CALL CPUTIM (ICTIME) 

1CTIM=ICT1ME/1 000000 
WRITE (NOT, 2002) TIME,1CTIM 
C 

NPAGt=0 

NLINE=0 

MAXL1N=52 


READ (NIT, 1001) IRUNNO, MINI , UNAME 

IFCRUNNO .NE . AHSTOP .AND. IRUNNO .NE. oHRETURN) GO TO 10 
WRITE (NOT, 2003) 
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IMIRUNNO .EC. 4HSTOP) STOP 
IFfIRUNNO .EQ. 6HRETURNI RETURN 
C 

10 read (NIT, 10021 TITLEl 
READ (NIT, 10021 T1TLE2 
RETURN 
END 



on on 
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'c 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

1 : 

c 

c 

c 

c 

c 

c 

c 

c 

c 


SUBROUTINF STIFl C PP tD AE ,Z »NPP,NDAE*KD AF ,K2 I 
DIMENSION PP(n, DAE(KDAE,1I, ZIKZ.U 

CALCULATE STIFFNESS MATRIX (FREE-FREE) FOR A LONGITUDINAL ROD. 
ASSUMES CONSTANT FORCE BETWEEN CONSECUTIVE PANEL POINTS- 
TRANSL/,TION AT EACH PANEL POINT ARE THE GENERALIZED COORDINATES 
INPUT IS DISTRIFUTED STIFFNESS (AE). 

SUBROUTINE IS ALSO A^PLICAtLE FOR TORSIONAL POD. THEN ROTATION AT 
EACH PANEL POINT ARE THE GENERALIZED COORDINATES, DISTRIBUTED 
STIFFNESS IS GJ. 

CALLS FORMA SUBROUTINE Z2BOMB. 

CODED BY C tOOLEY. FEPRUAPY 1966, 

LAST REVISION BY WA BENFIELD. MARCH 1976. 


SUBROUTINF ARGUMENTS 

PP - INPUT VECTOR OF PANEL POINTS. SIIE(NPP). 

DAE = INPUT matrix OF DISTRIBUTED STIFFNESS STRAIGHT LINE 

SEGMENT DATA. SIZE (MOAF,4) . 

COL 1 = X AT SEGMENT END 1. 

COL 2 - X AT SEGMENT END 2. 

COL 3 = STIFFNESS AT SEGMENT END 1. 

COL 4 = STIFFNESS AT SEGMENT END 2. 

Z = OUTPUT STIFFNESS MATRIX. SIZE (NPP ,NPP ) . 

NPP = INPUT NUMBER OF PANEL POINTS. SIZE OF VECTOR PP, MATRIX Z< 

NDAE = INPUT NUMBER OF SEGMENTS (ROWS) IN DAE. 

KDAE = INPUT ROW DIMENSION OF DAE IN CALLING PROGRAM. 

KZ = INPUT ROW DIMENSION OF Z IN CALLING PROGRAM. 


NERROR EXPLANATION 

1 = LESS THAN 2 PANEL POIN-'S. 

2 = PANEL POINTS NOT IN INCREASING ORDER. 

3 = DISTRIBUTED DATA MUST START AND END ON FIRST 

AND LAST PANEL POINTS. 

4 = OISTRIBUTFC DATA HAS GAPS. 

5 = NEGATIVE STIFFNESS IS NOT ALLOWED. 

CHECK THAT PANEL POINTS ARE IN INCREASING ORDER. 

'TERROR = 1 

IF (NPP .LI. 2) GO TO 999 

NERRCR = 2 

00 5 K=?,NPP 

IF (PP»K-1) ,GE. PP(K)| GO TO 999 
5 CONTINUE 


CHECK FIRST AND LAST POINTS UF DlSTRIBUIED STIFFNESS MATRIX, 

NEPROR = 3 

IF (DAE(1,1) .NE. PP(1) .OR. 0AE(N0AE,2) .NE. PP(NPP>) GO TO 999 

INITIALIZE DATA, 
on 10 1=1 ,NPP 
DO 10 J=1,NPP 
10 2( I ,J) = 0.0 
NE-A'''' = NPP-1 
X2SAVi V- DAE (1,1) 

C 
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or 90 I=1,NPAE 
XI = DAE( 1,1) 

X? = OAF( 1,2) 

VI = DAF( 1,3) 

V2 = OAE( 1,4) 

NFKROR = 4 

IF (XI .GE. X2 .OR. XI .NE. X2SAVE) GO TO 999 

IF (VI .LE. 0. .OR. V2 .LE. 0.) GO TC 999 
X2SAVE = X2 
DO 32 K=^1,NBAYS 
IF (XI .LT. PP(K+D) GO TO 34 
32 CONTINUE 
34 XP = XI 
VP = VI 

36 IF (X2 .LF. PP(K-H)) GO TO 38 
XQ = PP(K+1) 

VQ = VI ♦ (XQ-X1)*(V2-V1)/(X2-X1) 

GO TO 39 

38 XO = X2 
VQ = V2 

39 B = (VQ-VP)/(XO-XP) 

IF (B .tO. 0.) GO TO 55 

2(K,K) = Z(K,K) ♦ ALOG(VQZVP) / 6 

GO TO 70 

55 4(K,K) = 2(K,K) + (XQ-XP)/VP 

70 IF (X2 .LE. PP(K+D) GO TO 90 
K = K+1 
XP = XO 
VP = Vf 
GO TC 3 
90 CONTINUE 

ST0R2 ^ 2 0,1) 

2 ( 1 , 1 ) = 0.0 
DO 120 K=1,NSAYS 
L = K + 1 

STOP) = 1./ST0R2 
ST0R2 = 2(L,U 
Z(K,K) = 2(K,K) + STORl 
Z(K,L) = -SIC PI 
2(L,K) = -STORl 
120 2 (L,L) - STORl 
RETURN 


NERROR = 4 
NERROR = 5 


C 


999 CALL 22BOMB (6HST1F1 ,NERROR) 
END 
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C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

r 

c 

c 

c 

c 


c 


SUPRDUTINF STIF2 (PPtDKAG.DE I ,2»NPP ♦K'DK AG ,NOE I ,N2 tKPKAG.KDEI tKZ ) 
DIMENSION PP(U,DKAG(KDKAG»1) tDEI(KDEI»l»,Z<KZ,ll 

CALCULATE STIFFNESS MATRIX (FFEE-FREE) FOR A PEAM. ASSUMES CONSTANT 
SHEAR AND LINEARLY VARYING BENDING MCMFNT FtTWEEN CONSECUTIVE PANE u 
POINTS. LATERAL TRANSLATION AND ROTATION AT EACH PANEL POINT ARE THE 
GENERALIZED COORDINATES.. TRANSLATION COOROIN/ ES ARE GROUPED FIRST 
FOLLOWED PY RC TAT ION COORD INATES. 

SIGN CONVENTION IS ROTATION = -DILATERAL D ISP) /O (AXIAL COORDINATE). 
INPUT IS DISTPIPUTEO ^LEXURE STIFFNESS, FI, AND ON OPTION 
(NDKAG .GT. 0) DISTRIBUTED SHEAR STIFFNESS, KAG. 

CALLS FORMA SUPRCUTINE ZZEOMB. 

COOED BY C BODLEY. FEBRUARY 1966. 

LAST REVTSION BY WA BENElElD. MARCH 1976. 


SLBM 

PP 

DKAG = 


DEI 


Z 

NPP 

NDKAG 

NDEI 

NZ 

KOKAG 

KDEI 

K2 


-UTIME ARGUMENTS 

^ INPUT VECTOR OF PANFl POINTS. SIZE(NPP). 

: INPUT MATRIX OF DISTRIBUTED SHEAR STIFFNESS STRAIGHT ' "NF 
SEGMENT DATA. SI ZE (NDKAG ,A ) . 

COL 1 = X AT SEGMENT END 1 . 

COL 2 - X AT SEGMENT END 2. 

COL 3 = STIFFNESS AT SEGMENT cmq 
COL ~ STIFFNESS AT SEGMENT END 2. 

= INPUT MATRIX OF DISTRIBUTED FLEXURE STIFFNESS STRAIGHT LINE 
SEGMENT data SI ZE(NDE 1,4) . 

COLUMNS ARE SIMILAR TO DKAG. 

: OU-.UT STIFFNESS MATRIX. SIZE(N2,NZ). 

= INPUT HUMBER OF PAN*^L POINTS. SIZF OF VECTOR PP,. 

: INPUT NUMBER OF SEGMENTS (ROWS) IN DKAG. CAN BE ZERO. 

INPUT NUMPEP OF SEGMENTS (ROWS) IN DEI. 

- OUTPUT SIZE OF MATRIX 2. (NZ = 2*NPP) . 

: INP'H ROW DIMENSIO.V CE DKAG IN CAlLiNG PROGRAM. 

= INPUT RCW DIMENSION OF DEI IN CALLING PROGRAM. 

: INPUT ROW DIMENSION OF Z IN CALLING PROGRAM. 


NERRC'R FXPLANATION 

1 = LESS TUAN ? PANEL POINTS. 

2 - PANEL POINTS NOT IN INCREASING ORDER.. 

3 = DISTRIBUTED DATA MUST STARi AND END ON FIRST 

AND LAST PANEL POINTS. 

4 = DlSTRir-UTEO DATA HAS GAPS. 

5 - NEGATIVE STIFFNESS IS NOT ALLOWED. 


CHECK THAT PANEL POINTS ARE IN INCREASING ORDER. 

NEkROR = I 

IF (NPP ,LT. 2) GO TO 999 

NEPROR - 2 

DP S K=?,\!PP 

IF (PP(K-l) ,GE. pc«K)) GO TO 999 
5 CONTINUE 

CHECK FIRST AND LAST POINTS OF DISTRIBUTED STIFFNESS MATRICES. 

NERROR - 3 

IF (NDKAG .EC, 0) GO TO 7 

IF (DKAG(1,1J .NE. PP (1 ) .OR. DKAG(NDKAG,2) .NE. PP(NPP))GO TO / 
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7 IF (DEI (1,11 ,NE. ppm .OR. DEI (NOEI ,21 .NE. PP(NPPIIGO TO 999 

X INITIALIZE DATA. 

N2 = 2*NPP 
DO 10 1=1 ,NZ 
DO 10 J=1,NZ 
!0 Z(I,JI = 0.0 
NBAYS = NPP-1 
C 

DO 95 iT = 1,2 

IF (NT .EQ. 1 .AND. NDKAG .EQ. 01 GO TO 95 

IF (NT .EC. II NSEGS = NDKAG 

IF (NT .EG. 1) X2SAVE = DKAG(1,1I 

IF (NT .EG. 2) Nc'EGS = NDEl 

IF (NT .EG. 2) X2SAVE = DEI(I,1) 



DO 

90 1=1, NSEGS 



GO 

TO (21,22), NT 


21 

XI 

= DKAG(I,1) 



X2 

= 0KAG(I,2I 



VI 

= DKAG(I,3) 



V2 

= 0KAG(I,41 



GO 

TO 30 


22 

XI 

= DEI(I,1) 



X2 

= 0EI(I,2) 



VI 

= DEI(I,3) 



V2 

= 0EI(I,4) 


30 



NERROR 


IF 

(XI .GE. X2 .OR. XI .NE. X2SAVE) GO TO 999 





NERROR 


IF 

(VI .LE. 0. .OR. V2 .LE. 0-1 GO TO 999 



X2SAVE = X2 



DO 

32 K=1,NPAYS 



IF 

(XI .LT. PP(K+in GO TO 34 


32 

CONTINUE 


34 

XP 

= XI 



VP 

= VI 


36 

IF 

(X2 .LE. PP(K+in GO TO 38 



XO 

= PP(K+1) 



VO 

= VI ♦ (XQ-X1I*(V2-V1)/(X2-X1) 



GO 

TO 39 


38 

XO 

= X2 



VO 

= V2 


39 

PL 

= XO-XP 



HP 

= XP-PP(KI 



HO 

= XO-PP(K) 



A : 

= (VP*HO - VQ’KHPl/PL 



e = 

= (VO~VP)/PL 



VLOG = ALrG(VQ/VP) 



GO 

TO (50, 60), NT 


50 

IF 

(B .EQ. 0,1 GO TO 55 



Z(K,K) = Z(K,KI ♦ VLOG/b 
GO TO 70 

55 Z(K,K) = 2(K,K) ♦ PL/VP 
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GCl TO 70 
60 L = K+NPP 

IF (B .EQ. 0.» GO TO 65 

ZCK,K| = ZIK.K) + |HQ**2-HP**2»/(2.*PI - A*PL/B»»2 ♦A**2*VL0G/B**3 
Z(K,L» = Z(K,L) ♦ PL/B - A*VL0G/B*>»=2 
Z(LtL> = Z(L,L) ♦ VLOG/B 

GO TO 70 

65 Z<K,K) = ZIK,K) ♦ ( H0**3-HP*«=3»/I3.*VP| 

ZIK,U = Z(K,L) ♦ IHQ^*2~hP**2l/l2.*VPI 

Z(L,U = ZCL.LI + PL/VP 

C 

70 IF <X2 .LE. PP(K*in GO TO 90 
K = K+1 
XP = XO 
VP = VO 
GO TO 36 
90 CONTINUE 
95 CONTINUE 
C 

NPPl = NPP + 1 
STP21 = Z(l,l» 

STP22 Z(1,NPP1) 

STR23 = Z (NPPl, NPPl I 
Z(l,l) = 0. 

2(1,NPP!I =0.0 

Z (NPPl, NPPl )=0.0 
DO 120 K=1,NBAYS 
L = K ♦ 1 
H = K ♦ NPP 
N = M ♦ 1 

0 = STR21*STR23 - STR22^*2 
BL = PP(K+1I - PP(K) 

STRll = STR23/D 

STRl? = “STR22/D 

STR13 = STR21/0 

STR21 = Z(L,U 

STR22 = Z(L,NI 

STR23 = Z(N,NI 

Z(K,Ki r Z(K,K) ♦ STRll 

Z(K,LI = -STRll 

Z(K,M) = 2(K,M) ♦ STR12 

Z(K,N| = -(EL*STR11 + STR12) 

Z(L,LI - STRll 
Z(L,M) = -STR12 
Z(L,N) = -Z(K,N) 

Z(M,M| = 2(M,M» ♦ STR13 
Z(M,N) = -{BL*STR12 ♦ STR13) 

120 Z(N,N) = B: *»2=»=STR11 ♦ 2.*BL*STR12 ♦ STR13 
C 

C SYMMETRIZE. 

DO 160 1=1, NZ 
DO 160 U-'I,NZ 
160 Z(J,I) = Z(I,JI 
RETURN 


C 
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999 CALL ZZBOMB C6HSTIF2 fNERROR) 
END 
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SUBROUTINE SYMLH |AfN,KRI 
DIMENSION A(KR,1» 

SYMMETRIZE MATRIX A BY PLACING VALUES FROM 
ABOVE THE DIAGONAL BELOW THE DIAGONAL. 

CODED BY RL WOHLtN. FEB 1965. 

SUBROUTINE ARGUMENTS 

A = INPUT, OUTPUT SUPPLIED AND RESULT MATRIX. SIZE(NtN). 
N = INPUT SIZE OF MATRIX A (SQUARE). 

KR = INPUT ROW DIMENSION OF A IN CALLING PROGRAM. 

DO 10 1=1, N 
DO 1C J=I,N 
10 A(Jtl) = A(I,J) 

RETURN 

END 
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SUBROUTINE SYMUH (A,NfKR) 

DIMENSION A(KR,1) 

SYMMETRIZE MATRIX A BY PLACING VALUES FROM 
BELOW THE DIAGONAL ABOVE THE DIAGONAL - 
CODED BY RL WOHLEN. FEB 1965. 

SUBROUTINE ARGUMENTS 

A = INPUT, OUTPUT SUPPLIED AND RESULT MATRIX. SIZE(N,N). 
N = INPUT SIZE OF MATRIX A (SQUARE). 

KR = INPUT ROW DIMENSION OF A IN CALLING PROGRAM. 

DO 10 1=1 ,N 
DO 10 J=I,N 
10 A(I,J) = A(J,I) 

RETURN 

END 
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SUBROUTINE TERPl (XA» XZ.YA* VZ ,NXA tNXZ *NCAfK A»K2I 
DIMENSION XAdlfXZm *YA(KA,U,YZCKZt II 

LINEAR INTERPOLATION. 

VALUES OF XZ MAY BE OUTSIDE OF XA. C EXTRAPOLATION I . 

CODED BY RE hRUDA. SEPTEMBER 1965. 

LAST REVISION BY J ERNST, OCT 1973. 

SUBROUTINE ARGUMENTS 

XA = INPUT VECTOR OF X-COORD INATES FOR ROWS OF YA. MUST BE IN 
INCREASING ORDER. SIZEINXA). 

XZ = INPUT VECTOR OF X-COORD INATES FOR INTERPOLATED VALUES. 
SIZE(NXZ) . 

YA = INPUT MATRIX OF Y-COORD INATES TO BE INTERPOLATED. 

SIZEINXA, NCA). 

YZ = OUTPUT MATRIX OF INTERPOLATED Y-COORDINATES . SIZEfNXZ,NCA) • 
EACH COLUMN OF YZ HAS INTERPOLATED VALUES OF THE 
RESPECTIVE COLUMN OF YA. 

NXA = INPUT NUMBER OF XA STATIONS, ROWS OF MATRIX YA. 

NXZ = INPUT NUMBER OF XZ STATIONS, ROWS OF MATRIX YZ. 

NCA = INPUT NUMBER OF COLUMN VECTORS IN MATRICES YA,Y2. 

KA INPUT ROW DIMENSION OF YA IN CALLING PROGRAM. 

KZ = INPUT ROW DIMENSION OF YZ IN CALLING PROGRAM. 

DO 30 K = 1,NXZ 
DO 10 1=1, NXA 

IFIXZIK I.LE.XA(I+1) .OR. (Idl.EQ.NXA) GO TO 20 
10 CONTINUE 
20 DO 30 J = 1 ,NCA 

30 YZCK,J) = YA|I,J) + (XZ(KI-XAmi*fYACI+l,J)-YAII,Jl )/ 

♦ (XAfU-ll-XAIlM 

RETURN 

END 
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SUBROUTINE TERP2 (XA, XZ, YA* Y2 .NXA ,NXZ »NCA*KA*KZI 
DIMENSION XAdltXZm ,YA(KA ,I I ,YZ (KZ, II 
C 

C DIPARA&OLIC INTERPOLATION. 

C (PARABOLIC INTERPOLATION IN FIRST, LAST BAYS AND OUTSIDE XAl. 

C VALUES OF XZ MAY BE OUTSIDE OF XA. (EXTRAPOLATION!. 

C CALLS FORMA SUBROUTINE ZZBOMB. 

C COOED BY RE HRUDA. FEBRUARY 196 5. 

C LAST REVISION BY WA BENFIELD. MARCH 1976. 

C 

C SUBROUTINE ARGUMENTS 

C XA = INPUT VECTOR OF X-COORD INATES Ff^ ROWS OF YA. MUST BE IN 
C INCREASING ORDER. SIZE(NXAI. 

C XZ = INPUT VECTOR OF X-COORD INATES FOR INTERPOLATED VALUES^ 

C SIZE(NXZI. 

C YA = INPUT MATRIX OF Y-COORD INATES TO BE INTERPOLATED. 

C SIZE(MXA,NCA) . 

C YZ = OUTPUT MATRIX OF INTERPOLATED Y-CCORDINATES. SIZE(NX2,NCA) . 

C EACH COLUMN OF YZ HAS INTERPOLATED VALUES OF THE 

C RESPECTIVE COLUMN OF YA. 

C NXA = INPUT NUMBER OF XA STATIONS, ROWS OF MATRIX YA. 

C NXZ = INPUT NUMBER OF XZ STATIONS, ROWS OF MATRIX YZ. 

C NCA = INPUT NUMBER OF COLUMN VECTORS IN MATRICES YA,YZ. 

C KA = INPUT ROW DIMENSION OF YA IN CALLING PROGRAM. 

C KZ = INPUT ROW DIMENSION OF YZ IN CALLING PROGRAM. 

C 

NERR.OR EXPLANATION 
C I = LESS than 3 STATIONS. 

C 

NERROR = I 

IF (NXA .LT. 31 GO TO 999 
C 

DO 400 K=1,NXZ 

IF (XZ(K| .LE.XA(2I) GO TO 100 
IF (XZ(K| .GE.XA(NXA-I|| GO TO 300 
DO 50 1=3, NXA 

IF (XZ(K) .LE.XA(II) 60 TO 200 
50 CONTINUE 
C 

C FIRST BAY OR LEFT EXTRAPOLATION. 

100 BAYL = XA(?I-XA(1I 

H = (XZ(K )-XA(1I)/PAYL 
D = (XA(3)-XA(in/BAYL 
DO 102 J=I,NCA 

102 YZ(K,J)= YA(1,JI*(H**2-H*(1.0+D)+0I/D 

♦ + YA(2,JI*(H*’F2-H*DI/(1.0~0I 

♦ + YA(3,JI’»'(-H=F*2+H)/(D-0**2| 

GO TO 400 

C 

C INTERIOR BAY. 

200 BAYL = XA(I)-XA(I~1 I 

H = (XZ(K) -XA(I-1II/BAYL 
C = (XA(I-2)-XA(T-in/BAYL 
0 = (XAd+ll-XAd-lM/BAYL 
DO 202 J=1,NCA 
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202 YZ(K,J)= VAfI-2,J)*(H**3-2.0*H**2+H)/*C-C*»2) 

♦ ♦ YA(I-1» J)*(H**3*CC-D)+H**2<'(2.0*D-CJ-H*(D+C*DI+C*DI/fC»DI 

♦ ♦ YA(I ,J)*<H%»3»CD-C)+M**2*n.0~2.0»D+CI-«»C»a*0-DH/ 

♦ <<i.o-c)*(i.o-on 

♦ + YACI+1*J)*(-H»*3+H»*2)/(D-D*=^2» 

GO TO 400 

LAST BAY OR RIGHT EXTRAPOLATION. 

300 BAYL = XA(NXA)-XA(NXA~1) 

H = IXZfkl -XA<NXA~1 n/BAYL 
C = (XAfNXA-2)-XA(NXA-l )I/BAYL 
DO 302 J=1,NCA 

302 YZIK,J)= YA(NXA-2*J)*f-H**2+H)/fC-C**2) 

♦ + YA<NXA~l,J)’>tH**2“H*(1.0+C)+C)/C 

♦ + YA(NXA ,J)’»'IH**2-H*C)/C1.0-C) 

400 CONTINUE 
RETURN 

999 CALL ZZBOMB (6HTERP2 ,NERROR) 

END 
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SUPP0U7INF TIMCHK(NAMCHK) 

COMMON /LTIMF / NTM ,NOCK( 10 ) ,NAM < 10 ) ♦ TOTT(IO) ,TLAS( 10 ) 

COMMON /LLINE / NLINE tMAXLINt MINI 
data nit, not/5,6/ 

DATA KT/10/ 

THF PURPOSE OF THIS ROUTINE IS TO DETERMINE THE ELAPSED CPU TIME 
BETWEEN DEFINED POINTS IN A PROGRAM. UPTO 10 DEFINED TIME CHECKS 
CAN BE OBTAINED USING THIS ROUTINE. THE ROUTINE IS USED BY CALLING 
IT AT THE POINT IN THE PROGRAM WHERE THE TIME CHECK IS TO START AND 
THEN CALLING IT AGAIN AT THE POINT WHERE THE TIME CHECK IS TO END. 

THE TIME CHECK IS IDENTIFIED BY THE ARGUMENT NAMCHK AS AN VARIABLE 
(IE NAMCHK=6HT1ME 1». IF MORE THAN ONE TIME CHECK IS MADE USING THE 
SAME NAME FOR THE ARGUMENT NAMCHK THE SUM OF THE ELAPSED TIMES WILL BE 
RECORDED. 

BEFORE THIS ROUTINE CAN BE USED IT IS NECESSARY TO INITIALIZE IT. 

THIS DONE BY CALLING IT WITH NAMCHK =6HTBEGIN. 

THE RESULTS OF THE TIME CHECKS MADE BY THIS ROUTINE ARE PRINTED 
BY CALLING IT WITH NAMCHK=6HTPRINT. THE DATA PRINTED CONSISTS OF 
A TABLE CONTAINING THE NAMES OF THE TIME CHECKS, THE TOTAL ELAPSED 
CPU TIME FOR EACH NAMED TIME CHECK, THE NUMBER OF TIMES EACH NAMED 
TIME CHECK WAS MADE, AND THE AVERAGE CPU TIME FOR EACH NAMED TIME 
CHECK (IE TOTAL ELAPSED TIME DIVIDED BY THE NUMBER TIMES THE TIME 
CHECK WAS MADE). 

ARGUMENT 

NAMCHK - INPUT ( A6 FORMAT) '^IME CHECK IDENTIFICATION 

IF(NAMCHK=6HTEEGIN) ROUTINE IS INITIALIZED 
IF(NAMCHK=6HTPRINT) RESULTS ARE PRINTED 

FORMA SUBROUTINES CALLED ARE PAGEHD AND ZZBOMB. 

CODED BY JOHN ADMIRE *NASA» AUG 1973. 

2000 F0RMAT(/1X123(1H“)) 

2010 F0RMAT(//51X24(1H*)/51X24H* CPU TIME CHECK TABLE ♦, 

♦/37X50( 1H*)/37X, 

♦50H* name of ♦ TOTAL * NUMBER OF ♦ AVERAGE */37X, 

♦50H* TIME CHECK * CPU TIME ♦ CHECKS MADE ♦ CPU TIME ♦/37X50(1H*)I 
2020 FORMAT (37X, 

♦4H* ,A6,5H ♦ ,F8.2,2H ♦5X,I3,5X2H* ,F8.2,2H ♦ 

♦/37X50( 1H*| ) 

IF(NAMCHK .EQ. 6HTBEGIN) GO TO 60 
IF (NAMCHK .E&. 6HTPRINT) GO TO 80 
L=NTM+1 

CALL CPUTIM(ICTIM) 

C1=ICTIM 

C1=C1/1000000. 

It 'NTM .NE. 0) GO TO 30 
10 NERR0R=1 

IF(L .GT. KT) GO TO 999 

NAM(L)=NAMCHK 

NTM=L 
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20 TLAS(U=C1 
RETUPN 

30 00 AO I=1,NTM 
LL=I 

IF(NAMCHK .EO. NAMdll GO TO 50 
A-0 CONTINUE 
GO TO 10 
50 L=LL 

IFCTLASfLI .LT. 0.) GO TO 20 
TOTTa)=TOTT(L) + CCl-TLAS(U ) 

TLAS(U=-1. 

NCCK(L>=NOCK(L)-H 
RETURN 
60 NTM=0 

DO 70 1=1, KT 
NOCKd J=0 
NAM(I)=6H 
T0TTU)=0. 

70 TLAS(n=-l. 

RETURN 

80 IFfMINI .NE. AHMINII GO TO 90 

IF(NLINE .IE. 5 .OR. NLINE .GE. MAXLIN} GO TO 90 
NN=10+NTM-2' 

IFCNLINF+NN .GT. MAXLIN) GO TO 90 
WRITE(NOT,2000) 

NLINt=NLINE+2 
GO TO 100 
90 CALL PAGEHO 
100 WRITE (NOT, 2010) 

NLlNE=NLINE+8 

NEPRPR=2 

IF(NTM .EO. 0) GO TO 999 
00 120 1=1, NTM 

IF(NLINE4^2 .LE. MAXLINI go to 110 

CALL PAGE HD 

WRITE(N0T,2010) 

NLINE=NLlNE+8 
110 C2=N0CK(I I 

C1=T0TT(I I/C2 

WRITE(NOT, 20201 NAM ( I ) ,T0TT ( II ,NOCK (I ) ,C1 
120 NLIME=NLINE+2 
RETURN 

999 CALL ZZB0MB(6HTIMCHK,NERR0R) 

END 
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SUBROUTINE TRAE2 UXRUNO,IXNAME,IFAtA. IFC.C,IFDfOtIFE,Ef 

♦ ZTMM,STaRTT,ENOT»MLTXTP,NWR1T6*ZIOENT»STA, 

♦ ZNAME»NZtKZ,NXTAPE,NZTAPEtSTOREZ) 

DIMENSION A(KZ,n ,e CKZ 1 1 » tC (KZ, IJ ,0 CKZt U tE (1 1 tZTMMCKZ 1 1 1 • i # , 

♦ ZIDENT(n,STOREZCKZfl» 

DIMENSION ST0RETC6) 

COMMON /LWRKVl/ XDDf250), XDt250) 

COMMON /LWRKV2/ X(250), ZC250I 
COMMON /LWRKV3/ F(500» 

COMMON /LSTART/ IZRUN0,Z0ATE,NPAGE,UNAMEI3I tTITLE 1( 12 I #TITLE2 ( 12 1 
COMMON /LLINE/ NLINE»MAXLINfMlNI 
DOUBLE PRECISION 5tSS,ZER0 
DATA ZERO/O.D/ 

DATA NIT,N0T/5»6/ 

DATA NLPP.BUF, EOT/ 

♦ 54 ♦ 0..3HE0T/ 

C 

C SOLVE THE MATRIX EQUATION 

C Z(T) = A*XDD(T) ♦ B=>XD( ) ♦ C=^X(TI ♦ D*FIT) ♦ E 

C THAT IS» THE ADDITIONAL EQUATIONS TO GET SHEAR, BENDING MOMENT, ETC. 
C T,XOO,XO,X,F ARE OBTAINED FROM NXTAPE (OUTPUT OF TIME RESP SUBRTI. 

C NXTAPE IS POSITIONED BY SEARCHING FOR RUN NUMBER (IXRUNO) AND 
C NAME (IXNAME). 

C THE ANSWER Z(T) WILL BE WRITTEN ON NZTAPE EVERY MLTXTP*XDELTA (OF 
C TIME PESPf AND ON PAPER EVERY NWRITE*(MLTXTP*XOELTAI . 

NZTAPE MUST HAVE BEEN INITIALIZED WITH SUBROUTINE INTAPE. A HEADER, 
TIME POINT DATA, AND END-OF-FILE WILL BE WRITTEN ON NZTAPE HERE. 

-Jc THE MAXIMUM AND MINIMUM VALUES OF Z WILL BE DETERMINED AND OUTPUT 
C THRU MATRIX ZTMM. 

C COMMON /LSTART/ IS DEFINED IN SUBROUTINE START. 

C INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

C CALLS FORMA SUBROUTINES PAGEHD ,ZZBOMB . 

C THE MAXIMUM SIZES ARE (BASED ON DIMENSIONS OF XDD,XD .X,F,Z 1 
C NX = 250 

C NF = 500 

C NZ = 250 

C COOED BY RL WOHLFN. MARCH 1965. 

C LAST REVISION BY RL WOHLEN. MARCH 1976. 

C 

C SUBROUTINE ARGUMENTS 

C IXRUNO = INPUT RUN NUMBER OF TIME RESPONSE DATA TO BE READ FROM 
C NXTAPE. (A6 FORMAT). 

C IXNAME = INPUT IDENTIFICATION OF TIME RESPONSE DATA TO BE READ FROM 
C NXTAPE. (A6 FORMAT). 

C IFA = INPUT A NEED NOT BE DIMENSIONED IN MAIN PROG FOR IFA = 0 

C A = INPUT MATRIX COEFFICIENT OF XOD. SIZE (NZ,NX). 

C IFB = INPUT B NEED NOT BE DIMENSIONED IN MAIN PROG FOR IFB = 0 

C B = INPUT MATRIX COEFFICIENT OF XD. SIZE (NZ,NX). 

C IFC = INPUT C NEED NOT BE DIMENSIONED IN MAIN PROG FOR IFC = 0 

C C = INPUT MATRIX COEFFICIENT OF X. SIZE (NZ,NX). 

C IFD = INPUT D NEED NO’^ BE DIMENSIONED IN MAIN PROG FOR IFD = 0 

' D = INPUT MATRIX COCfFIClENT OF F. SIZE (NZ,NF). 

IF5 = INPUT E NEED NOT ?E DIMENSIONED IN MAIN PROG FOR IFE = 0 

C E ^ INPUT VECTOR. SIZE (NZ). 

C ZTMM = OUTPUT MATRIX OF Z MAX, MIN AND TIMES. SIZE (NZ,4). 



n n 


TRAE2 — 2/ 5 


C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

,c 

'c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 


STARTT 

ENDT 

MLTXTP 

NWRITE 

ZIDENT 

STA 

ZNAME 

NZ 

KZ 

NXTARF 

NZTAPE 

STOREZ 


CPL 1 = Z MAX, COL 2 = TIME AT Z MAX, 

COL 3 = Z MIN, COL A = TIME AT Z MIN. 

INPUT START TIME FOR ADDITIONAL EOUATIONS. MAY BE GREATER 

THAN START TIME USED IN TIME RESPONSE. IF LESS, 

TIME RESPONSE START TIME IS USED. 

INPUT END TIME FOR ADDITIONA* EOUATIONS. MAY BE LESS 

THAN END TIME USED IN TIME RESPONSE. IF GREATER, 

TIME RESPONSE END TIME IS USED. 

INPUT MULTIPLE OF TIME RESPONSE POINTS TO USE FOR ADO. EOS 
MLTXTP = 1 USE EVERY TIME RESP POINT (1,2,3,...} 
MLTXTP = 2 USE EVERY SECOND TIME RESP POiNT (1,3,5, 
ETC 

INPUT MULTIPLE OF ADDITIONAL EQS POINTS TO WRITE ON PAPER. 
NWRITE = 1 WRITE EVERY POINT (1,2,3,...) 

NWRITE = 2 WRITE EVERY SECOND POINT (1,3,5,...) 

ETC 

INPUT HEADING FOR Z IN PRINTED OUTPUT. (12A6 FORMAT). 

INPUT STATIONS FOR ROWS OF Z IN PRINTED OUTPUT. SIZE (NZ). 
(A6 FORMAT). 

INPUT IDENTIFICATION OF ADDITIONAL EOS DATA TO BE WRITTEN 
ON NZTAPE. (A6 FORMAT). 

INPUT NUMBER OF ROWS IN A ,B,C,D, E,ZTMM , STOREZ . MAX=250. 
INPUT ROW DIMENSION OF A, B,C,D,ZTMM, STOREZ IN CALLING PROG 
INPUT NUMBER OF TAPE FROM WHICH T,XOD,XD,X,F WILL BE READ. 
(EG 1). 

INPUT NUMBER OF TAPE ON WHICH T, 2 WILL BE WRITTEN. (EG 1C? 

IF NZTAPE = 0, BYPASS WRITING 2 ON NZTAPE. 

INPUT WC*RKSPACE MATRIX TO STORE SIX COLUMNS OF Z FOR 
PRINTING. SIZE (NZ,6). 


THE OUTPUT DATA (TO BE WRIITEN ON NZTAPE AND PAPER) IS 
T - TIME 

Z = SHEAR, BENDING MOMENT, ETC. SIZE(NZ). 


NERROR EXPLANATION 

1 = SIZE EXCEEDANCE. 

2 = X AND Z DATA CANNOT SHARE SAME TAPE. 

3 = RFOUFSTED RUN NUMBER OR NAME CANNOT BE FOUND. 

4 = NX OR NF EXCEEDS ALLOWABLE SIZE. 


2010 FORMAT (/ 15X, 12A6 // 9X,6HTIME = F14 .6,5F17.6) 

2011 FORMAT (2X,3HROW, 3 X, 7HSTAT10N ) 

2012 FORMAT ( I5,AX,A6,6E17.8) 

2050 FORMAT (/ IX 123(1H-) ) 


IF (NZ .GT. 250) GO TO 999 
IF (NXTAPE .EQ. NZTAPE) GO TO 999 


NERR0R=1 

NERRCR=2 


SEARCH NXTAPE FOR CORRECT HEADING. 

REWIND NXTAPE 

2 READ (NXTAPE) ITkUNO, ITNAME ,I FOTCK , XS TART,XDELTA,XEND,NX,NF ,NXTP 
IF (ITRUNG.EQ.IXRUNO .AND. ITNAME .EQ. IXNAME ) GO TO 5 


NERROR-3 
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IF (lEPTCK .FO* 3HEOT) GO TO 999 
DO 3 IXTP=1,NXTP 
3 READ (NXTAPE) 

GO TO 2 

5 NERRQR=4 
IF (WX .GT. ?50 .OR. NF .GT. 500) GO TO 999 

2START = STARTT 
ZEND = FNDT 

IF (2START .LT. XSTART) ZSTART = XSTART 
IF (ZEND .GT. XEND ) ZEND = K. ND 

HXDEL = .5»XDELTA 

FIND X-TIME POINT NUMBER FOR ZSTART. 

DO 6 IXTP=ltNXTP 

XTIME = XSTART + FLOAT( lXTP-1 )*XDELTA 
IF (ABS(ZSTART~XTIME) .LE. HXDEL) GO TO 7 

6 CONTINUE 

7 IXTP2S = IXTP 
ZSTART = XTIME 

FIND X-TIME POINT NUMBER FOR ZEND. 

IZTP = 1 

8 IXTP = IXTP + MLTXTP 

XTIME = XSTART + FLOAT! IXTP-1 )*XDELTA 
IZTP = lZTP+1 

IF (XTIME .LF. (2END+HXDEL) ) GO TO 8 
IXTPZE = IXTP-MLTXTP 

ZENO = XSTART + FLOAT ( lXTPZE-1 )*XDELTA 
NZTP - IZTP-1 

ZDELTA = FLCAT(MLTXTP )*XDELTA 

SKIP RECORDS ON NXTAPE UP TO X-TIME POINT NUMBER FOR ZSTART. 

IF "XTPZS .EO. 1) GO TO 10 
IXZSM = IXTP2S-1 
DO 9 I=1,1XZSM1 

9 READ (NXTAPE) 

SEARCH NZTAPE FOR END OF WRITTEN DATA. 

10 IF (NZTAPE .LE. 0) GO TO 20 
REWIND NZTAPE 

15 READ (NZTAPE) EUF IN »BUF IN ,I FOTCK , ( BUFIN ♦ I-l $4) ,NR EC 
IF (lEOTCK .EO. 3HE0T) GO TO 17 

DC 16 IREC=l,NkEC 

16 READ (NZTAPE) 

GO TO 15 

17 BACKSPACE NZTAPE 

WRITE (NZTAPE) IZRUNO ,Z NAME ,ZDATEt ZSTA^ T , ZDELTA t Z END ,NZ tNZTP, 

♦ (BUF, 1=1,11) ,(ZIDENT(I),I=1,12),(STA(1),I=1,N2) 

ADDITIONAL EQUATIONS LOOP. 

20 ( XTP = MLTXTP-1 

DC 399 IXTP=IXTPZS, IXTPZE 
LXTP = LXTP4) 

IF (LXTP',FO. MLTXTP) GO TO 25 
READ (NXTAPE) 
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GO TO 3«>9 

25 READ (NXTAPEI T, (F (J ) t ) « IXODf I) tl»l tNXI» (XDf 1) »l>ltNX) t 
* fX(I) tI=ltNX) 

LXTP = 0 
DO 35 1=1, NZ 
35 ZCl) = C. 

IF CIFA .EO. 0) GO TO 50 
DO 45 1=1, NZ 
SS = ZERO 
DO 44 J=1,NX 
S = AII,J»*XDD(JI 

44 SS = SS ♦ 5 

45 zm = zm ♦ SS 

50 IF (IFP ,E0. 0) GO TO 60 
DO 55 1=1 ,NZ 
SS = ZERO 
DO 54 J=1,NX 
S = E(I,J)*XDtJ) 

54 SS = SS + S 

55 Z(I) = HI) ♦ SS 

60 IF (IFC .EO. 0) GO TO 70 
DO 65 1=1 ,NZ 
SS = ZERO 
DO 64 J=1,NX 
S = C(1,J)*X(J) 

64 SS = SS ♦ S 

65 zm = Z(I) ♦ SS 

70 IF (IFD .EO. 0) GO TO 80 
DO 75 1=1 ,NZ 
SS = ZERO 
DC 74 J=1,NF 
S = D<I,J)*F(J) 

74 SS = SS ♦ S 

75 Z(I) = Z(I) ♦ SS 

80 IF tlFE .EO. 0) GO TO 100 
DO 65 1=1, NZ 
85 Z(I) = Z( I) ♦ Ed) 

WRITE T,Z ON NZTAPE FOR LATER USE. 

100 IF INZTAPE .GT. 0) WRITE (NZTAPE) T,iZ( I) ,1=1 ,N2) 

CALCULATE MAXIMUM AND MINIMUHS OF Z. PLACE IN ZTMM. 

COL 1 = Z MAX, fOL 2 = TIME OF Z MAX, 

COL 3 = Z MIN, COL 4 = TIME OF Z MIN. 

IF (IXTP .GT. IXTPZS) GO TO 150 
DO 110 1=1, NZ 
ZTMM(I,n = 2(1) 

ZTMM(I,2) = T 
ZTMM(I,3) = 2(1) 

110 ZTMM(I,4) = T 
NCOL = 0 
GO TO IRQ 
150 DO 155 1=1, NZ 

IF (ZII) .LE. ZTMM(1,D) GO TO 152 
ZTMM(I,t) = Z(I) 
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ZTMM(I,2I = T 

152 IF (Zni .GE. ZTMMU,3n GO TO 155 
ZTMMIIt3l = Z(I» 

ZTMMCitA) = T 
155 CONTimJE 

c 

C SEE IF DATA SHOULD BE PRINTED. 

C COLLECT SIX COLUMNS OF T AND 2 BEFORE PRINTING. 

IF (IXTP.LT.IXTPZE .and. NW.LT.NWRITEI go TO 210 
190 NCOL = NCOL ♦ 1 
STORET(NCOL) = T 
DO 200 1=1, NZ 
200 STOREZd.NCOLl = Z(ll 
NW = 0 

210 NW = NW + 1 

IF (IXTP.LT.IXTPZE .AND. NC0L.LT.6) GO TO 399 
NZF = 0 

381 NZS = NZE ♦ 1 
NZE = NZ 

IF ((NZE-NZS) .GT. (NLPP-11 )l NZE=MZS+CNLPP-1 1 ) 

IF (MINI .NF. AHMINII GO TO SCO 

IF (NLINE .LE. 5 .OR. NLINE .GE. MAXLIN) GO TO 800 
IF ((NLINE^2+5+NZI .GT. MAXLINl GO TO 800 
WRITE (NOT, 2050) 

NLINE = NLINE ♦ 2 
GO TC 810 
800 CALL PAGE HD 

810 WRITE (NOT, 2010) (ZIDENT(I), 1=1,121, (STORETdl, I=1,NC0L) 
WRITF (NOT, 2011) 

NLINE = NLINE ♦ 5 
DO 387 I=NZS,NZE 
NLINE = NLINE ♦ 1 

387 WRITE (NOT, 201?) 1 ,STA(I ) ,( STOREZd,J ), J=1,NC0LI 
IF (NZ .GT. NZE) GO TO 381 
NCOL = 0 
399 CONTINUE 
C 

IF (NZTAPE .LF. 0) RETURN 

WRITE (NZTAPE) BUF,BUF,EOT, (BUF,I=1 ,16) 

ENOFILE NZTAPE 
RETURN 
C 

999 CALL ZZBOMB (6HTRAE2 ,NERROR) 

END 
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SUBROUlINF TRANS ( A,ZtNRA,NC A,KRA«KRZI 
DIMENSION A(KRA,1), ZIKRZ«1> 

TRANSPOSE MATRIX A INTO MATRIX Z. 

COOED BY RL WOHLEN. FEB 1965. 


A 

Z 

NRA 

NCA 

KRA 

KRZ 


SUBROUTINE ARGUMENTS 

= INPUT MATRIX. SIZE(NRA»NCA). 

= OUTPUT RESULT MATRIX. S IZEf NCA,NR A) • 

= INPUT NUMBER OF ROWS OF MA1RIX A» COLS OF MATRIX 2. 
= INPUT NUMBER OF COLS OF MATRIX A« ROMS OF MATRIX Z. 
= INPUT ROM DIMENSION OF A IN CALLING PROGRAM. 

= INPUT ROM DIMENSION OF Z IN CALLING PROGRAM. 


DO 10 1=1, NRA 
DO 10 J=1,NCA 
10 Z(J,II = A(I,Jl 
RETURN 
END 
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SUPPOUTlNf TRWM f IXRUNO,IXNAME,XTMM,STARTT»ENDT,NX*KX,NXTAPEI 

DIMFNSICN XTMMIKXtll 

COMMON /LWPKVl/ XDDI250), XDC2:?0) 

COMMON /LWRKV2/ XI 500 1 

FIND XDD, XP, X MAXIKUMS, MINIMUMS, AND TIME OF OCCURRENCE FROM TIME 
RESPONSE TAPE. 

NXTAPE IS POSITIONED BY SEARCHING FOR RUN I4UMBER (IXRUNOI AND 
NAME fIXNAME). 

THE MAXIMUM SIZE IS IB/ "ED ON DIMENSIONS OF XDO«XD,XI 
NX = 250 

DFVFLCPFD PY RL WOHLEN. NOVEMBER 1975- 
LAST REVISION BY KA EENFIELD. MARCH 1976- 

SUBRCUTINF ARGUMENTS 

IXRUNC = INPUT RUN NUMBER OF TIME RESPONSE DATA TO BE READ FROM 

NXTAPE. IA6 FORMAT). 

IXNAME = INPUT IDENTIFICATION OF TIME RESPONSE DATA TO BE READ FROM 

NXTAPE. IA6 FORMAT). 

XTMM = OUTPUT MATRIX OF MAX* MINS AND TIMES. SIZEINX,12). 

COL 1 = XDD MAX COL 2 = TIME AT XDD MAX 

COL 3 = XDD MIN COL 4 = TIME AT XDD MIN 

COL 5 = XO MAX fOL 6 = TIME AT XD MAX 

COL 7 = XD MIN COL 8 = TIME AT XD MIN 

COL 9 = X MAX COL 10 = TIME AT X MAX 

COL 11 = X MIN COL 12 = TIME AT X MIN 

STARTT = INPUT START TIME FOR MAXIMUM* MINIMUMS. MAY BE GkEATER 

THAN START TIME USED IN TIME RESPONSE. IF LESS* 

TIME RESPONSE START TIME IS USED. 

ENDT = INPUT END TIME FOR MAXIMUM* MINIMUMS. MAY BE LESS 

THAN END TIME USED IN TIME RESPONSE. IF GREATER* 

TIME RESPONSE END TIME IS USED. 

NX = OUTPUT NUMBER OF ROWS IN MATRIX XTMM. MAX=250. 

KX = INPUT ROW DIMENSION GF XTMM IN CALLING PROGRAM. 

NXTAPE = INPUT NUMBER OF TAPE FROM WHICH T*XDD*XO*X HILL BE READ- 

lEG 1). 

NEPROP EXPLANATIONS 

1 = REQUESTED RUN NUMBER OR NAME CANNOT BE FOUND- 

2 = SIZE EXCEEDANCE. 

SEARCH NXTAPE FOR CORRECT HEADING. 

REWIND NXTAPE 

2 READ INXTAPF) ITKUNO* ITNAME*! EOTCK *XSTART,XOELTA* XENO,NX»NF,NXTP 
IF IITRUMO.EQ.IXRUNO .AND. ITNAME .EQ. IXNAME ) GO TO 5 

NERR0R=1 

IF IIEGTCK .FO. 3HECT) GO TO 999 
DO 3 IXTP=1,NXTP 

3 READ INXTAPF) 

GO TO 2 

5 NERR0R=2 

IF (NX .GT. 250) GO TO 999 
STRMM = STARTT 
ENDMM = FNDT 

IF (STRMM .LT. XSTART) STRMM - XSTART 
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IF (ENDMM .GI. XEND ) EMDMM = XEND 
HXDEL = .5<^XDELTA 

FIND X-TIME POINT NUMBER FDR MAX-MIN START. 

DC 6 1XTF=1,NXTF 

XTIME = XSTART ♦ FLGaTC IXTP-1 l*XDELTA 
IF lAPSfSTRMM-XTTMEI .LE. HXOELl GO TO 7 

6 CONTINUE 

7 IXTPS = IXTP 

FIND X-TlME PPINT NUMBER FOR MAX-MIN END. 

8 IXTP = IXTP ♦ 1 

XTIME = XSTAPT ♦ FLOAT* IXTP-1 l*XDELTA 
IF IXTIME .LE. (ENDMM+HXOELII GO TO 8 
IXTPE = IXTP - 1 

SKIP RECORDS ON NXTAPE UP TO X-TIME POINT NUMBER FOR MAX-MIN START. 
IF *IXTPS .EO. IJ GO TO 100 
IXTSMl = IXTPS-1 
DO 9 1=1, IXTSMl 

9 READ (NXTAPE) 

FIND MAXIMUMS AND MINIMUMS. PLACE IN XTMM. 
t COL 1 = XDD MAX COL 2 = TIME AT XOO MAX 

C COL 3 = XDD MIN COL 9 = TIME AT XDO MIN 

C COL 5 = XD MAX COL 6 = TIME AT XO MAX 

j COL 7 = XD MIN COL 6 = TIME AT XO MIN 

- C COL 9 = X MAX COL 10 = TIME AT X MAX 

C COL 11 = X MIN COL 12 = TIME AT X MIN 

100 DO 39^ 1XTP=IXTPS, IXTPE 

READ (NXTAPE) T, (DUM,J=1,NF) , (XDD ( I ) , I=1,NX ) , ( XD(I ) , I=1,NX I , 

* (X(I),I=1,NX) 

IF (IXTP .GT. IXTPS) GO TO 200 
DO 110 1=1, NX 


XTMM'l, 

1 ) 

- 

XDD(I) 

XTMMd, 

2) 

= 

T 

XTMMd , 

3) 


XOD(I) 

XTMMd, 

4) 


T 

XTMMd , 

5) 

=■ 

XD(I) 

XTMM j , 

6) 


T 

XT ,xd. 

7) 

- 

XD(I) 

rfMMd , 

8) 

= 

T 

XTMMd, 

P) 

- 

Xd) 

XTMMd , 

10) 


T 

XTMMd , 

11) 


Xd) 

110 XTMMd, 

1? 1 


T 

GO TO 3 

99 




200 DO 290 1=1, NX 

I»^ (XDD (I) .LE. X7MM(I,D) GO TO 21 f» 
XiMMd, 1 ) = XDD(I) 

XTMMd, 2) = T 

215 IF (XDD(I) .GE. XTMMd, 3)) GO TO 220 
XTMMd, 3) = XDDd) 

XTMMd, 4) = T 

220 If iXD d) .LE. XTMMII,5)) GO TO 225 
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XTMM<I, 5) = XD(XI 
XTMMd, 6) = T 

225 IF fXD (I) .GF. XTMM(I,7n GO TO 230 
XTMMd, 7) = XDd) 

XTMMd, 8 ) = T 

230 IF IX (I) .LE. XTMMdf9») GO TO 235 

XTMMd ♦ o) = xm 

XTMMd, 10) = T 

235 IF (X d) -GF. XTMMd, IDJGO TO 290 
XTMMd, 11 ) - Xd) 

XTMMCI,12) = T 
290 CONTINUE 
C 

399 CONTINUE 
C 

RETURN 

C 

999 CALL 22EOMB I6HTRMM ,NERROR) 

END 
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SUBROUTINE TRPSD ( 1XPUN0,IXNAME,IRAE,IEXP,STARTT,MLTXTP,ZPSD, 

* NFPEQ*TIMPER»NXTAPE,WRKV» 

DIMENSION 2PSDC1I, WRKVdl 
COMMON /LWRKVl/ X<500l 

CALCULATE PSD OF ONE ROW OF TIME RESPONSE ADDITIONAL EQUATIONS 
CADD EQI DATA FROM SUBROUTINE TRAE?. DEFINE X = ADO EQ, Z = PSD. 

X IS OBTAINED FROM NXTAPE (OUTPUT OF ADO EO SUBROUTINE TRAF2I. 

NXTAPE IS POSITIONED BY SEARCHING FOR RUN NUMBER (IXRUNOl AND 
NAME (IXNAME). 

CALLS FORMA SUBROUTINE ZZBOMB. 

THE MAXIMUM SIZE IS (BASED ON DIMENSION OF XI 
NX = 500 

COOED BY RL WOHLEN. JANUARY 1976. 

LAST REVISION BY WA BENFIELO. MARCH 1976. 

SUBROUTINE ARGUMENTS 

IXRUNO = INPUT PUN NUMBER OF ADD EQ DATA TO BE RE/«) FROM NXTAPE. 

(A6 FORMAT). 

IXNAME = INPUT IDENTIFICATION OF ADO EQ DATA TO BE READ FROM 

NXTAPE. (A6 FORMAT). 

IRAE = INPUT ROW NUMBER OF ADD EQ USED IN PSD CALCULATION. 
lEXP = INPUT EXPONENT OF 2. GIVES NUMBER OF TIME POINTS USED 

IN PSD CALCULATION. NZTP=2**IEXP. MAX IEXP=13. 

EG* lEXP = 5, 10* 11* 12, 13. 

NZTP = 32, 1024* 2048, 4096, 8192. 

STARTT = INPUT START TIME FOR PSD CALCULATION. MAY BE GREATER THAN 

START TIME USED IN ADD EQ. IF LESS, ADD EQ START TIME 
IS USED. 

MLTXTP = INPUT MULTIPLE OF ADD EO POINTS TO USE FOR PSD CALCULATION. 

MLTXTP = 1 USE EVERY ADD EQ POINT (1,2,3,...) 

MLTXTP = 2 USE EVERY SECOND ADD EQ POINT (1,3,5,...) 
ETC 

ZPSD - INPUT WORKSPACE VECTOR. MUST BE DIMENSIONED AT LEAST 2»NZTP 

WHERE NZTP=2*»IEXP. 

= OUTPUT VECTOR OF PSDS AT VARIOUS FREQUENCIES FOR ROW IRAE 
OF ADD EO. 

ZPSD(l) AT FRE0=0 

ZPS0(2) AT FREQ=1/0ATA TIME PERIOD 
ZPSD(3) AT FREQ=2/DATA TIME PERIOD 
ETC 

ZPSD(NZTP/2) AT FREC= (NZTP/2-1 )/D ATA TIME PERIOD. 
NFREQ = OUTPUT NUMBER OF FREQUENCIES AT WHICH PSD IS CALCULATED- 

NFPEO = NZTP/2 WHERE NZTP=2**I EXP. 

TIMPER = OUTPUT TIME PERIOD OF DATA USED FOR PSD CALCULATION. 

NXTAPE - INPUT NUMBER OF TAPE FROM WHICH X WILL BE READ. (EG 1). 

WRKV = INPUT WORK VECTOR. DIMENSION AT LEAST NZTP/2-1 IN CALLING 

PROGRAM. 

NERROR EXPLANATION 

1 = MAXIMUM ALLOWABLE EXPONENT SIZE EXCEEDED. 

2 = REQUESTED RUN NUMBER OR NAME CANNOT BE FOUND. 

3 = SIZE EXCEEDANCE. 

DEFINITION... X IS ADDITIONAL EQUATIONS, Z IS PSD. 
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NERRORsl 

IF (lEXP .GT. 131 GO TO 999 
NZTP = 2**IEXP 

NXTP = NZTP ♦ CNZTP-1)^(MLTXTP-1I 

SEARCH NXTAPE FOR CORRECT HEADING. 

REWIND NXTAPE 

2 READ (NXTAPE) ITRUNO, ITNAME,IFOTCK,XSTART,XDELTAtXEND,NX*NXREC 
IF (ITPxONO.EQ.IXRUNO .AND. ITNAME.EQ.IXNAMfcl 60 TO 5 

NERR0RS2 

IF (lEOTCK .tQ. 3HE0T) GO TO 999 
DC 3 IXREC=^1,NXREC 

3 READ (NXTAPE) 

GO TO 2 

5 NERR0R=3 
IF (NX .GT. 500) GO TO 999 

HXDEL = .5*XDELTA 

FIND X-TIME POINT NUMBER FOR ZSTART. 

ZSTART = STARTT 

IF (ZSTART .LT. XSTART) ZSTART = XSTART 
DO 6 IXTP=1,NXTP 

XTIME = XSTART ♦ FLOAT( IXTP-l )*XDELTA 
IF (APS(ZSTART-XTIME) .LE. HXDEL) GO TO 7 

6 CONTINUE 

7 IXTPZS = IXTP 
ZSTART = XTIME 

FIND X-TIMF POINT NUMBER FOR ZEND. 

ZEND = ZSTART ♦ FLOAT (NXTP-1 )*XDELTA 

NERR0R=4 

IF (ZEND .GT. XEND) GO TO 999 
IXTPZE = IXTPZS + NXTP - 1 

SKIP RECORDS ON NXTAPE UP TO X-TIME POINT NUMBER FOR ZSTART. 

IF (IXTPZS .EQ. 1) GO TO 10 
IXZSMl = IXTPZS-1 
DO 9 1=1 , IXZSMl 
9 READ (NXTAPE) 

READ ADDITIONAL EQUATIONS DATA. 

10 SUM =0.0 
IZTP = 0 
LXTP = MLTXTP-1 
DO 399 IXTP=IXTPZStIXTPZE 
LXTP = LXTP+1 

IF (LXTP .EQ. MLTXTP) GO TO 25 
READ (NXTAPE) 

GO TO 399 

25 READ (NXTAPE) T, (X ( I ) , 1=1, NX ) 

LXTP = 0 

SUM = SUM ♦ X(IRAE) 

IZTP = lZTP+1 
ZPSD(IZTP) = X(IRAE) 

IZTP = IZTP+1 
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ZPSDCIZTP) 0.0 
399 CONTINUE 

SUBTRACT AVERAGE VALUE FROM ORIGINAL DATA. 

AVRG SUM/FLOAT(NZTP) 

NZTP2 = 2*NZTP 
DO 510 IZ =l,NZTP2tZ 
510 ZPSDCIZ) = ZPSD(IZ) - AVRG 
C CALCULATE FOURIER COEFFICIENTS. 

CALL FORT (ZPSD, IE XP»WRKV,-1*IERR) 

C FORM PSD VALUES. 

TIMPER = ZEND-ZSTART 
TWOPER = 2. ★TIMPER 
NFREQ = NZTP/2 
DO 520 I=1,NFRE0 
12 = 2*1 

520 ZPSDd) = TWOPER* (ZPSD( 12-1 )**2 + ZPSD(I2I**2) 
RETURN 
C 

999 CALL ZZBOMB (6HTRPSD tNERROR) 

END 
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SUBROUTINF TRSPl (A ,B ,C ,D ,TABT,TABF ,XOO ,XO, STARTT.OFLTAT , ENOT , 

♦ NWR1TB,NX,NF,NTF,XNAME,KA,KF,NTAPE,NUT1 ) 

DIMENSION A(KA,n«B(KA,l),C(KA»ll«D(KA«l)«TABT(KF,n tTABF(KF,l)« 

♦ XDOflltXOd) 

DIMENSION P(4I 

COMMON /LWRKVI/ XDD (250 I »XO 1250) 

COMMON! /LWRKV2/ 00( 250 ) »Q (250 ) 

COMMON /LWRKV3/ X (250 ) .AIDE (250) 

COMMON /LWPKV4/ F(500) 

COMMON /LSTART/ I RUNNO.DATE ,NPAGE »UNAME (3 ) .TITLEl ( 12 ) tTITLE2 ( 12 ) 
COMMON /LLINE/ NLINE,MAXLIN,MINI 
DOUBLE PRECISION S.SSfZERO 
DATA ZERO/O.D/ 

DATA NIT, NOT/5, 6/ 

DATA NLPP,BUF,DIVTCL, EOT/ 

♦ 54 , 0.,1.E+35,3HE0T/ 

C 

C RESPONSE ROUTINE TO SOLVE THE SECOND ORDER DIFFERENTIAL EQUATION 
C (A)XOD + (6)XD + (OX = (DIF FOR XDD, XO, X. 

C FOURTH ORDER RUNGE-KUTTA (GILL MODIFICATION) NUMERICAL INTEGRATION 
C IS USED. 

C VECTOR F IS OBTAINED BY LINEAR INTERPOLATION USING TABT.TABF. 

C MATRICES A,B,C,D SHOULD NOT SHARE SAME CORE LOCATION (DUE TO MULTB). 

C THE ANSWERS (T,F, XDD ,XD,X ) WILL BE WRITTEN ON NTAPE EVERY OELTAT AND 
C ON PAPER EVERY NWRITE ♦ DELTAT. 

p NTAPE MUST HAVE BEEN INITIALIZED WITH SUBROUTINE INTAPE. A HEADER, 

TIME POINT DATA, AND END-OF-FILE WILL BE WRITTEN ON NTAPE HERE. 

C COMMON /LSTART/ IS DEFINED IN SUBROUTINE START. 

C INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

C CALLS FORMA SUBROUTINES INVl ,MULTB ,PAGEHD, ZZBOMB . 

C THE MAXIMUM SIZES ARE (BASED ON DIMENSIONS OF XOD,XD,X,F) 

C NX = 250 

C NF = 500 

C CODED BV PL WOHLEN. MARCH 1965. 

C LAST REVISION BY RL WOHLEN. MARCH 1976. 

C 

C SUBROUTINE ARGUMENTS (ALL INPUT) 

C A = MATRIX COEFFICIENT OF XDD- SIZE (NX, NX). ♦ DESTROYED ♦ 

C B = MATRIX COEFFICIENT OF XD. SIZE (NX, NX). ♦ DESTROYED » 

C C = MATRIX COEFFICIENT OF X. SIZE (NX, NX). ♦ DESTROYED ♦ 

CO = MATRIX COEFFICIENT OF F. SIZE (NX,NF). * DESTROYED ♦ 

C TABT = TABLE OF TIMES FOR FORCE IN TABF. SIZE (NF,NTF). 

C TABF = TABLE OF FORCES. SIZE (NF,NTF). 

C XDO = VECTOR OF INITIAL VELOCITIES. SIZE (NX). 

C XO = VECTOR OF INITIAL DISPLACEMENTS. SIZE (NX). 

C STARTT= START TIME. 

C OELTAT= integration STEP SIZE. 

C ENDT = ENF TIME. 

C NWRITE= MULTIPLE OF INTEGRATION POINTS TO WRITE ON PAPER. 

C NWRITE = 1 WRITE EVERY POINT (1,2,3,...) 

C NWRITE = 2 WRITE EVERY SECOND POINT (1,3,5,...) 

FTC 

i NX = SIZE OF MATRICES A,B,C (SQUARE). NUMBER OF ROWS IN D. MAX=250. 
C NF = NUMPEF OF ROWS IN TABT, TABF. NUMBER OF COLS IN D. MAX=500. 

C NTF = NUMBER OF COLS IN TABT, TABF. 
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•. XNAME = IDENTIFICATION OF DATA TO BE WRITTEN ON NTAPE. IA6 FORMAT). 
. KA = ROW DIMENSION OF A,B,CtD IN CALLING PROGRAM. 

C KF = ROW DIMENSION OF TABT.TABF IN CALLING PROGRAM. 

C NTAPE = NUMBER OF TAPE ON WHICH ANSWERS WILL BE WRITTEN. (E.G. 10). 

C NUTl = NUMBER OF THE UTILITY TAPE. (E.G. 4). 

C 

C THE OUTPUT DATA (TO BE WRITTEN ON PAPER AND NTAPE) IS 
C T = TIME 

C F = FOPCE OBTAINED BY LINEAR INTERPOUTICN ON TABF. SIZE (NF). 

C XDD = ACCELERATION. SIZE (NX). 

C XD = VELOCITY. SIZE (NX). 

C X = DISPLACEMENT. SIZE (NX). 

C AIDF = A**-l*D*F. SIZE (NX). (WRITTEN ON PAPER ONLY). 

C 

C NERROR EXPLANATION 

C 1 = SIZE EXCEEDANCE. 

C 2 = START TIME LESS THAN TABLE BOUNDS. 

C 3 = END TIME GREATER THAN TABLE BOUNDS. 

C 4 = RUN HAS DIVERGED. 

C 

2001 FORMAT 
1 
2 

3 

4 

2040 FORMAT 
2050 FORMAT 
2060 FORMAT 
♦ 

♦ 

2250 FORMAT 
C 

IF (NX 
C 

C PRINT INPUT SCALARS. 

IF (MINI ,NE, 4HMINI) GO TO 10 

IF (NLINE .LE. 5 .OR. NLINE . GE . MAXLIN) GO TO 10 
IF ((NLlNE+2+13) .GT. MAXLIN) GO TO 10 
WRITE (NOT, 2250) 

NLINE = NLINE + 2 
GO TO 11 

10 CALL PAGEHD 

11 WRITE (NOT, 2001) STARTT,DELTAT,ENDT,NWRITE 
NLINE =• NLINE + 13 

C 

C SEARCH NTAPE FOR END OF WRITTEN DATA. 

REWIND NTAPE 

5 READ (NTAPE) BUFI N, BUFIN, lEOTCK , ( BUFIN, 1*^1 ,5 ) ,NREC 
IF (lEOTCK .EO. 3HE0T) GO TO 7 
DO 6 IRFC=1,NREC 

6 READ (NTAPE) 

GO TO 5 

7 BACKSPACE NTAPE 

c 


I fff I , 




lOH STARTT = F10.6, 
= F10.6, 
= F10.6t 
= 15 


//23X, - 

//23X, lOH DELTAT 

//23X, lOH ENDT 

//23X, lOH NKRITE = 15 ) 

(//PX,8H TIME = Flo. 6) 

(//9X,15H APPLIED FORCES / (lOX, 5E16.8)) 

(// 9X,4H ROW, 6X,13H ACCELERATION, 8X,9H VELOCITY, 
10X,13H DISPLACEMENT, 4X,19H A**-l ♦ 0 ♦ FORCES / 
(lOX, 13, 4E20.8)) 

(/ IX 123(1H-) ) 


// 


NERRORsl 


,GT. 250 .OR. NF .GT. 500) 60 TO 999 
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CHECK TIME TABLE (TABTU 
DO 18 1 = 1, NF 

NERR0R=2 

IF (STARTT .LT. TABTCI,!!) GO TO 999 
DO 1? J=?,NTF 

IF fTAbl(l,J-l» .GE. TABT(I,J)I 60 TO 14 
12 CONTINUE 
J = NTF+1 

14 IF (ENDT^ .LE. TABTHtJ-l) ) GO TO 18 

NERR0R=3 

GO TO 999 
18 CONTINUE 

CALCULATE NUMBER OF TIME POINTS TO BE USED. 

NTP = (ENDT-STARTT)/DELTAT + 1,1 


CALCULATE A**~1*B, k**-l*C, A**-1»D. 

REWIND NUTl 

WRITE (NUTl) ((B(I,J), 1=1, NX), J=1,NX) B=B 

CALL INVl (A, B, NX, KA) B=AI 

DO 45 J=1,NX 
DO 45 1=1, NX 

45 A(I,J) = B(I,J) A=AI 

REWIND NUTl 

READ (NUTl) ((B(I,J), 1=1, NX), J=1,NX) B=B 

CALL MULTB (A, B, NX, NX, NX, KA, KA ) B=AIB 

CALL MULTB (A, C, NX, NX, NX, KA, KA) C=AIC 

CALL MULTB (A, D, NX, NX, NF , KA, KA ) D=AID 


SET INITIAL VALUES. 

WRITE (NT APE) IRUNNO, XNAME, DATE , STARTT, DELTAT, ENDT,NX,NF, NTP, 

♦ (BUF,I=1,10) 

T = STARTT 

NW = NWRITE 
DO 80 1 = 1 ,NX 
QD(I) = 0.0 
Q (1) = 0.0 
XD(I) = XDO(l) 

80 X (I) = XO (I) 

DO 86 1=1, NF 
DO 84 J=1 ,NTF 

i; (T .LE. TABT(1,J+1) .OR. (J+1 ) .EQ.NTF) GO TO 86 
84 CONTINUE 

86 F(I) = TABF(I,J) + (T-TABT( 1, J ) ) ♦ (TABF ( I , J+1 )-T ABF ( I , J ) ) / 

♦ (TABTCI,J+1)“TABT(I,J)) 

DO 06 1=1 ,NX 
SS = ZERO 
DO 94 J=1 ,NF 
S = D(1,J)»F(J) 

94 SS = SS ♦ S 

96 AIDF(I) = SS 
DO 97 1=1 ,NX 

97 XDD(I) = AIDF(l) 

DO 99 1=1 ,NX 

SS = ZERO 
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DO 98 J=1,NX 
S = B(I,J)«^XD(J) 

SS = SS ♦ S 
S = C(I,J)^X(J» 

98 SS = SS ♦ S 

99 XOD(I) = XDDin - SS 

SET INTEGRATION CONSTANTS. 

PCI) = .5 

PC2) = 1. - SORTC.5) 

P(3) = 1. + SQRT(.5I 
PC4) = .5 

INTEGRATION LOOP. CK=1 ,HALF STEP), CK=:2,HALF STEP AG» 

CK=3,FULL STEP), (K=4,ENO OF STEP). 

GILL FACTOR = .5 
DO 399 ITP=1,NTP 



IF 

CITP .EQ. 

1) 

GO TO 340 



DO 

150 K=l,4 






DO 

110 1=1, NX 






Z 


XD Cl) * 

DELTAT 




ZD 


XDDCI) * 

DELTAT 




IF 

(K 

.FQ. 4) 

GO TO 105 




R 


PCK) * C 

Z - 

-0 CD) 




RD 


PCK) ♦ CZD~QOCD) 




GO 

TO 

107 





105 

R 


CZ - 2. 

♦Q 

Cl) )/6. 




RD 

= 

CZD - 2. 

♦0DCI))/6. 



107 

X 

(I) 

= X Cl) 

4 

R 




XD 

(I) 

= XDCI) 

+ 

RD 




Q 

(I) 

= 0 Cl) 


3.4R - 

PCK 

)*Z 

110 

QDCI) 

= QDCI) 


3.*RD - 

PCK 

)*Z0 


IF 

CK 

-NE. 1) 

GO TO 115 




T = T + .S^DELTAT 
GO TO 130 

115 IF (K .NE. 3) GO TO 140 

T = STAPTT ♦ FL0AT(ITP~1)4DELTAT 
130 DO 136 1=1, NF 
DO 134 J=1,NTF 

IF (T ,LE. TABT(I,J+1) .OR. f J+1 ) .EO.NTF ) GO TO 136 
134 CONTINUE 

136 FCI) = TABF(1,J) + (T-TABTC 1, J ) ) ♦ CTABF' I, J+1 l-TABFC I, J) ) / 
♦ (TABTCI,J+1)-TABTU,J) ) 

140 DO 146 1=1, NX 
SS = ZERO 
DO 144 J=1,NF 
S = D(I,J)*F(J) 

144 SS = SS ♦ S 

146 AIOFCI) = SS 
DO 147 1=1, NX 

147 XDDII) = AIOFCI) 

DO 140 1=1, NX 

SS = ZERO 
DO 148 J=1,NX 
S = BCI,J)TXOCJ) 
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ss = ss ♦ s 

S = C(ItJ)*X(J) 

148 SS = SS + 5 

149 XDDdI = XDDCll - SS 

150 C0NTI!NIUE 

WRITE ANSWERS ON NTAPE FOR LATER USE. 

340 WRITE (NTAPEI T, (F f I ) « I=l« NE ) « |XDD( II »I=1 fNXI t (XO C I I »I=1 »N O , 
♦ (X(II,I=I»NX) 

SEE IF DATA SHOULD BE PRINTbC. 

IF (ITP.LT.NTP .AND. NW .LT.NWRITC I GO TO 345 
NFL = NF/5 

IF (<NFL*5I .NE. NF 1 NFL = NFL+1 
IF (MINI .NE. 4HMINII GO TO 800 

IF (NLINE .LE. 5 .OR. NLINE .GE. MAXLIN) GO TO 800 
IF ((NLINE^^2+3+3+NFL+4+NXI .GT. MAXLIN) GO TO 800 
WRITE (NOT, 2250) 

NLINfc = NLINE + 2 
GO TO 810 
800 CALL PAGEHO 
810 WRITE (NOT, 2040) 1 

URITF (NOT, 2050) (F(I), 1=1 ,NF) 

NLINE = NLINE + 3 ♦ 3 + NFL 
NXS = 1 
NXE - NX 

NFLN = (NF-1 1/5+1 

IF ((NXE + NFLN) .GT. (NLPP-15H NXE=(NLPP-15 )-NFLN 

342 WRITE (NOT, 2060) (I, XOD(I), XDlI), X(D* AIDF(I), I=NXS,NXE) 
NLINE = NLINE + 4 ♦ (NXE-NXS+1) 

IF (NX .EQ. NXE) GO TO 343 
NXS = NXE + 1 
NXE = NX 

IF ((NXE-NXS) .GT. (NLPP- 9)) NXE=NXS+(NLPP- 9) 

CALL PAGEHD 
GO TO 342 

343 NW = 0 
345 NW = NW+1 

SEE IF RUN HAS OIVERGED- 

NERR0R=4 

DO 350 1=1, NX 

IF (ABS(XCI)) .GT. DIVTOL) GO TO 999 
350 CONTINUE 
C 

399 CONTINUE 

C 

WRITE (NTAPE) BUF ,BUF ,EOT , ( BUF, 1=1 , 16 ) 

END FILE NTAPE 
RETURN 
C 

999 ENDFILF NTAPE 

CALL ZZBOMB (6HTRSP1 ,NERROR) 

END 
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SUBROUTINE TRSPlA f A,B tC*0, FMAG.PP, VEL*GL ,XOO ,XO,STARTT,OELTAT, 

♦ ENOT,NWRITF,NX,NF,XNAME*KA,NTAPE,NUTn 
DIMENSION A(KA«1 ) ,B(KAtll «C (KAtl ) *0 (KA> II >FMAG{1) yPPI 1 ) • 

♦ XPOUItXOd) 

DIMENSION P(A| 

COMMON /LWPKVl/ XDO (250 ) ,XD J250 I 
COMMON /LWVKV2/ 00(2501,0(2501 
CCMMOM /LWRKV3/ X (250 I , AlDF C25C ) 

COMMON /LW»KV4/ F(500) 

COMMON /L^TART/ IPUNNO,OATE,NPAGE,UNAME f3),TITLClC12l ,T1TLE2< 12 I 
COMMON /LLINE/ NLINF,MAXLIN,MIN1 
DOUBLE PRECISION S,SS,2ERC 
DATA ZERO/P .0/ 

DATA A T, NOT/5, 6/ 

DATA NLPP,eUF*DIVTOL, PI , EOT/ 

♦ 54 , 0.,1.E+35,3.1415927,3HE0T/ 

C 

C THIS MODIFICA'^ION OF TRSPI USES (1-COS 1/2 FORCING FUNCTION- 
C RESPONSE ROUTINE TO SOLVE THE SECOND ORDER DIFFERENTIAL EQUATION 
C (AlXDD ♦ (PIXO ♦ (OX = (DIF FOR XOO, XD, X. 

C FOURTH ORDER RUNGE-KUTTA IGILl MOOIFICATICNI NUMERICAL INTEGRATION 
C IS USED. 

C the FORCING FUNCTION, F , IS A SINGLE PERIC*D (l-CCSI/2 FUNCTION 
C BEGINNING AT T=STARTT AND FORWARD PP. THF COORDINATES ARE FORCED 
C simultaneously (SUDDEN ENVELOPMENTI IF VECTOR PP IS CONSTANT, OR AS 
,C A PENETRATING FUNCTION (EACH C(30PDINATE FORCE LAGS ITS PREDECESSOR 
j DEPENDING ON PENETRATION RATE AND STATION SPACINGl IF VECTOR PP 
k IS NOT CONSTANT. 

C M, .'RICES A,B,C,D SHOULD NOT SHARE SAME CORF LOCATION (DUE TO MULTBI. 
C the answers {T,F,XOO,XO,X| will BE WRITTEN ON NTAPE EVERY DELTAT AND 
C ON PAPE® EVERY NWPITE * DELTAT. 

C NTAPE MUST HAVE BEEN INITIALIZED WITH SUBROUTINE INTAPE. A HEADER, 

C TIME POINT DATA, AND ENO-OF-FILE WILL BF WRITTEN ON NTAPE HERE. 

C COMMON /LSTAFT/ IS DEFINED IN SUBROUTINE START. 

C INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

C CALLS FORMA SUBROUTINES INVl ,MULTE ,PAGEHD, ZZBOMB . 

C THE MAXIMUM SIZES ARE (BASED ON DIMENSIONS OF XOO,XO,X,F| 

C NX = 250 

C NF = 500 

C CODED BY RL WOHLEN. APRIL 1965. 

C LAST REVISION BY RL WOHLEN. MARCH 1976. 

C 

C SUBROUTINE ARGUMENTS (ALL INPUT I 

C A = MATRIX COEFFICIENT OF XDD. SIZE (NX,NX|. ♦ DFSTROYED ^ 

C B = MATRIX COEFFICIENT OF XD. SIZE (NX,^‘XI- ♦ DFSTROYED ♦ 

C C = MATRIX COEFFICIENT OF X. SIZE (rJX,NXI. ♦ DESTROYED ♦ 

CO = MATRIX COEFFICIENT OF F. SIZE (NX,NF|. ♦ DESTROYED * 

C FMAG = VFCTO® OF COORDINATE FORCE MAGNITUDES SUBJECT TO (l-COSI/2 

C VARIATION. SIZE(NFJ 

C PP = VECTOR OF CGDRDINATt STATIONS, (CONSTANT IF SUDDEN 
C ENVELOPMENTI. POSITIVE DIRECTION FOR STATIONS IS OPPOSITE 

TO VFL DIRECTION. SIZE(NFI. 

VEL = PENETRATION PATE. 

C GL = GUST LENGTH. PERIOD OF (1-COS 1/2 FUNCTION. 

C XDO = VECTOR OF INITIAL VELOCITIES. SIZE (NX). 
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C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

(•' 


XO = VECTOR OF INITIAL DISPLACEMENTS. SIZE (NXl. 

STARTT= START TIME. FORCING FUNCTION BEGINS. 

OELTaT= integration STEP SIZE. 

ENOT = END TIME. 

NWRITE= MULTIPLE OF INTEGRATION POINTS TO WRITE ON PAPER. 

NWPITE = 1 WRITE EVERY POINT (I«2,3,...) 

NWRITE = 2 WRITE EVERY SECOND POINT (l,3,5«...l 

ETC 

NX = SIZE OF MATRICES A,B*C (SCUARE). NUMBER OF ROWS IN 0. MAX=250- 

NF = SIZE OF VECTOR FMAG» NUMBER OF COLS IN 0. MAX=500- 

XNAME = IDENTIFICATION OF DATA TO BE WRITTEN ON NTAPE. (A6 FORM.ATI . 

KA = ROW DIMENSION OF A«B«C«0 IN CALLING PROGRAM. 

NTAPE = NUMBER OF TAPE ON WHICH ANSWERS WILL PE WRITTEN. (E.G. 101. 
NUTl = NUMBER OF THE UTILITY TAPE. <E.G. 4j. 

THE OUTPUT DATA *T0 BE WRITTEN ON PAPER AND NTAPE I IS 
T = TIME 

F = FORCE EVALUATED BY ( 1-COS 1/2 EXPRESSION, SIZE fNFI. 

XOO = ACCELERATION. SIZE (NX). 

XO = VELOCITY. SIZE (NX). 

X = DISPLACEMENT. SIZE (NX). 

AIDF = A<=*-1R=D=«=F. SIZE (NX). (WRITTEN ON PAPER ONLY). 

NERRCR EXPLANATION 

1 = SIZE EXCEEDANCE. 

2 = RUN HAS DIVERGED. 

2001 FORMAT (////15X,A3H THE INPUT SCALARS TO SUBROUTINE TRSPIA ARE , 


1 

//23X, 

lOH 

STARTT 

= 

F10.6, 

2 

//23X, 

lOH 

DFLTAT 

=■ 

F10.6, 

3 

//23X, 

lOH 

ENOT 

= 

FlO-6, 

4 

//23X, 

lOH 

NWRITE 


15 

5 

//23X, 

lOH 

VEL 


E15.8, 

6 

//23X, 

lOH 

GL 

= 

E15.8 ) 


2040 FORMAT (//9X,8H TIME = F10.6) 

2050 FORMAT (//9X,15H APPLIED FORCES / (lOX, 5E16.8)) 

2060 FORMAT (// 9X,9h ROW, 6X,13H ACCELERATION, 8X,9H VELOCITY, 

* 10X,13H DISPLACEMENT, 4X,19H A*»-l ♦ D ♦ FORCES // 

♦ (lOX, 13, 4F20.8I) 

2250 FORMAT (/ IX 123(1H-| ) 

NERR0R=1 

IF (NX .GT. 250 .OR. NF .GT. 500) GO TO 999 


PRINT INPUT SCALARS. 

IF (MINI .NE. 4HMINI) GO TO 10 

IF (NLINE .LL. 5 .OR. NLINE .GE. MAXLIN) GO TO 10 
IF ((NLINF+2+17) .GT. MAXLIN) GO TO 10 
WRITE (NOT, 2250) 

NLINF = NLINE ♦ 2 
GO TO 11 

10 CALL PAGEHD 

11 WRITE (NOT, 2001) STARTT,DELTAT,ENDT,NWRITE, VEl ,GL 
NLINE = NLINE + 17 
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SEARCH NTAPE FCR END OF WRITTEN DATA. 

REWIND NTAPE 

5 READ fNTAPEJ EUFIN,eUFIN, lEOTCK, CBUFIN. 1=1,51 ,NREC 
IF (lEOTCk .EC. 3HEGTJ GO TO 7 

DO 6 IREC=1,NREC 

6 READ (NTAPE) 

GO TO 5 

7 BACKSPACE NTAPE 

CALCULATE NUMBER OF TIME POINTS tq BE USED. 

NTP = (ENDT-STARTTI/DELTAT -► 1.1 

CALCULATE A**-1*B, A*»-1*C, A»^-1*D. 


REWIND NUT) 

WRITE (NUTl) ((E(I,J), 

1=1, NX), J=1,NXI 

e=e 

CALL INVl 

(A, B, NX, 

KA) 

B=AI 

DO 45 J=1 ,NX 
DC 45 1=1, NX 
A(1,J) = B(I,J) 

REWIND NUTl 

READ (NUTl) ((B(I,J), 

1=1, NX), J=1,NX) 

A=A1 

B=B 

CALL MULTP 

(A, B, NX, 

NX, NX, KA, KA) 

B=AIE 

CALL MULTP 

(A, C, NX, 

NX, NX, KA, KA) 

C=AIC 

CALL MULTB 

(A, 0, NX, 

NX, NF, KA, KA) 

D=AID 


FIND FIEST STATION (FORWARD PP) TO ENTER GUST. 

FWDPP = PP(1) 

DO 50 1=1, NF 

IF (PP(I) .LT. FWDPP) FWDPP = PP(I) 

50 CONTINUE 

SET INITIAL VALUES. 

WRITE (NTAPE) IRUNNO, XNAME,DATE,STARTT,DELTAT,EN0T,NX,NF,NTP, 
♦ (BUF,I=1,10) 

T = STARTT 



NW 

= 1 

NWRITE 


TP 

IGL 

= 

2.*PI/GL 


DO 

80 

I 

=1 ,NX 


OD 

(I) 

— 

0.0 


Q 

(I) 

= 

0.0 


XO(I) 


xDoai 

80 

X 

(I) 

= 

XO (I) 


DO 

84 

I 

=1 ,NF 

84 

F( 

I) 

- 

0.0 


DO 

44 

I 

= 1 ,NX 

94 

AIOF( 

I) 

= 0. 


DC 

97 

I 

= 1,NX 

97 

X0D(1 

) 

= AIOF(I) 


00 

99 

I 

= 1 ,NX 


SS 

— 

ZERO 


DO 

98 

J 

= 1 ,NX 


s : 

= B 

(I 

,J )*X0( J) 


SS 

= 

SS 

♦ S 


s 

= C 

(I 

,J )*X( J) 

98 

SS 

— 

SS 

+ S 
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99 XDD(I> = XOOII) - SS 

'*C SET INTEGRATION CONSTANTS. 

P(l) = .5 

P<2) = 1. - S0RTI.5I 
Pf3) = I. ♦ SCRTI.5I 
P<4) = .5 

INTEGRATION LOOP. CK=1,HALF STEP), |K=2,HALF STEP AGAIN), 

CK=3,FULL STEP), <K=4,6N0 OF STEP)* 

GILL FACTOR = .5 



DO 

399 ITP=1, 

NTP 



IF 

(ITP .EO. 

I) GO TO 340 


DO 

150 K=l,4 




DO 

110 1=1, NX 




Z 

- 

XD (1) * 

OELTAT 



ZD 

= 

XDD(I) ♦ 

DELTAT 



IF 

CK 

.EO. 4) 

GO TO 105 



R 

r 

P<K) » ( 

z -0 m ) 



RO 

= 

P(K) * < 

ZD-ODCI) 1 



GO 

TC 

107 



105 

R 

= 

CZ - 2. 

♦Q (I))/6. 



RD 

= 

IZO - 2- 

»OD(I) )/6. 


107 

X 

m 

= X fl) 

♦ F 



XD 

m 

= XDII) 

RO 



0 

m 

= c m 

♦ 3.*R - 

P<K)»Z 

110 

00 

(I) 

= com 

* 3.*R0 - 

P(K)*ZD 


IF 


.NE. 1) 

GO TO 115 



T = T + .5*DELTAT 
GO TO 130 

115 IF (r .NE. 3) GO TO 140 

T = START! ♦ FL0AT(ITP-1)#DELTAT 
130 FWOGPD = VFL*(T-STARTT) 

DC 136 1=1, NF 
Ffl) =0.0 

6P0 = FWOGPD - {PP(I)-FWOPP) 

IF (GPO.GT.0.0 .AND. GPD.LT.GDFl 1 ) =FMAGf I)»f 1 .-COS|GPD*TPIGL ) )/2. 
136 CONTINUE 
140 DO 146 1=1, NX 
SS = ZERO 
DO 144 J=1,NF 
S = 0(I,J)*F(J) 

144 SS = SS ♦ S 

146 AIDFdl = SS 
DO 147 1=1, NX 

147 XDD(I) = AIDFd) 

DC 149 1=1, NX 

SS = ZERO 
OP 148 J=1,NX 
S = B<1,J)*XD(J) 

SS = SS ♦ s 
S = C(I,J)*XU) 

148 SS = SS ♦ S 

149 XDOm = XDDII) - SS 

150 CONTINUE 
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WRITF ANSWERS ON NTAPE FOR LATER USE- 
340 WRITE (NTAPE) T, (F (I I ,I=l,NF | , (XOO( I) 1 1>1 ,NX), fXOI I ) ,1=1 -)X' » 
♦ (X(I),I=1,NX) 

SEE IF DATA SHOULD P.E PRINTED. 

IF (ITP.LT.NTP -AND- NW.LT.NWRITE I GO TO 345 
NFL = NF/5 

IF <(NFL*5) -NE- NF ) NFL = NFL-H 
IF (MINI .NP. 4HMINI) GO TO 800 

IF (NLINE -LE- 5 -OR. NLIN* OF. HAXLIN) GO TO 800 
IF ( )NLINE+2+3^3+NFL'^4+NX) -GT- MAXLIN! GO TO 800 
WRITE (NOT, 2250) 

NlINE = NLINE + 2 
GO TO ElO 
800 CALL PAGEHD 
81 C WRITE (NOT, 2040) T 

WRITE (NOT, 2050) (F(I), I=1,NF) 

NLINE = NLINE + 3 + 3 + NFL 
NXS = 1 
NXE = NX 

NFLN = (NF-D/5 + 1 

IF ((NXE ♦ NFLN) -GT. (NLPP-15)) NXE= (NLPP-15 )-NFLN 

342 WRITE (NOT, 2060) (I, XDD(I), XD(I), X(II, AIDF(I), I=NXS,NXE) 
NLINE = NLINE + 4 ♦ (NXE-NXS+1) 

IF (NX -EC. NXE) GO TO 343 
NXS = NXE * I 
NXE = NX 

IF ((NXE-NXS) .GT. (NLPP-* 9)) NXE*NXS*(NLPP- 9) 

CALL PAGEHD 
GO TO 342 

343 NK = 0 
345 NW = NW+1 

SEE IF RUN HAS DIVERGED. 

NERR0R=2 

DO 350 1=1, NX 

IF (AES(X(D) -GT. DIVTOL) GO TO 999 
350 CONTINUE 
C 

399 CONTINUE 

C 

WRITE (NTAPE) BUF ,BUF ,EOT, ( BUF,1= 1 , 16) 

ENDFILE NTAPE 
RETURN 
C 

999 ENDFILE NTAPE 

CALL Z2B0MB ( 6HTRS.PXA ,NERROR) 

END 
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I SUBROUTINE TRSPIB I B,C,D, TABT ,TABF ,XOO,XO ♦STARTT,OFLTAT,ENDT, 

I * NWRITe,MX,NF,NTF,XNAMF,KA,KF,NTAPEl 

DIMENSION BCKA,1 ),C(KA,1I ,OfKA,lltTABT(KF*ll*TABF(KF,ll, 

♦ XPO(l),XO(ll 
DIMENSION P(4) 

COMMON /LWRKVl/ XDD 1250 J t XD 1250 1 
COMMON /LWRKV2/ QD ( 250 ) ,0 (2 50 ) 

COMMON /LWPKV3/ X(250 »,AIDF<250I 
COMMON /5.WRKVA/ FC500I 

COMMON /L START/ IRUNNC,DATE ,NPAGE,UNAME (3 J*TITLE1 (12I*TITLE2(121 
COMMON /LLINE/ NLINE,MAXLIN,MINI 
DOUBLE PRECISION S,SSt2ER0 
DATA 2FRC/0.D/ 

DATA NIT,N0T/5,6/ 

data NLPP,BUF,CIVT0L* EOT/ 

♦ 54 , 0.,I.E+35,3HE0T/ 

C 

C THIS MODIFICATION OF TRSPI ASSUMES COEFFICIENT OF XDD IS UNITY SO 
C that one less MATRIX SPACE IS REQUIRED. 

C RESPONSE ROUTINE TO SOLVE THE SECOND ORDER DIFFERENTIAL EQUATION 
C XDD IBIXD ♦ (CIX = (DIF FOR XODt XD* X. 

C FOURTH ORDER RUNGE-KUTTA (GILL MODIFICATION! NUMERICAL INTEGRATION 
C IS USED. 

C VECTOR F IS OBTAINED BY LINEAR INTERPOLATION USING TABT*TABF. 

C THE ANSWERS (T,FtXDD,XD,X! WILL BE WRITTEN ON NTAPE EVERY DELTAT AND 
C ON PAPER EVERY NWRITE ♦ DELTAT. 

|: NTAPE MUST HAVE BEEN INITIALI2ED WITH SUBROUTINE INTAPE. A HEADER, 

-C TIME POINT DATA, AND ENO-OF-FILE WILL BE WRITTEN ON NTAPE HERE. 

C COMMON /LSTART/ IS DEFINED IN SUBROUTINE START. 

C INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

C CALLS FORMA SUBROUTINES PAGEHD ,Z2B0MB. 

C THE MAXIMUM SI2ES ARE (BASED ON DIMENSIONS OF XDD,XD,X,F) 

C NX = 250 

C NF = 500 

C CODED BY RL WOHLEN. FEBRUARY 1R67. 

C LAST REVISION BY RL WOHLEN. MARCH 1976. 

C 

C SUBROUTINE ARGUMENTS (ALL INP'»T! 

C B = MATRIX COEFFICIENT OF XD . SI2E (NX, NX). 

C C = MATRIX COEFFICIENT OF X. SI2E (NX, NX). 

CO = MATRIX COEFFICIENT OF F. SI2E (NX,NF). 

C TABT = TABLE OF TIMES FOR FORCE IN TABF. SI2E (NF,NTF). 

C TABF = TABLE OF FORCES. SIZE (NF,NTF). 

C XDO = VECTOR OF INITIAL VELOCITIES. SIZE (NX). 

C XO = VECTOR OF INITIAL DISPLACEMENTS. SIZE (NX). 

c startt= start time. 

C DELTAT- INTEGRATION STEP SIZE. 

C ENDT = END TIME. 

C NWRITE= MULTIPLE OF INTEGRATION POINTS TO WRITE ON PAPER. 

C NWRITE = 1 WRITE EVERY POINT (1,2,3,...) 

C NWRITE = 2 WRITE EVERY SECOND POINT (1,3,5,...) 

S ETC 

i NX = SIZE OF MATRICES B,C (SQUARE). NUMBER OF ROWS IN D. MAX=250. 
C NF = NUMBER OF ROWS IN TABT, TABF. NUMBER OF COLS IN D. MAX=500. 

C NTF = NUMBER OF COLS IN TABT, TABF. 
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f. XNAME = IDENTIFICATirN OF DATA TO BE WRITTEN ON NTAPE. <A6 FORMAT!. 
J. KA = ROW DIMENSION OF B,CtD IN CALLING PROGRAM. 

C KF = ROW DIMENSION OF TABT,TABF IN CALLING PROGRAM. 

C NTAPE = NUMBER OF TAPE ON WHICH ANSWERS WILL BE WRITTEN. lE.G. 101. 
C 

C THE OUTPUT DATA (TO BE WRITTEN ON PAPER AND NTAPE I IS 

C T = TIME 

C F = FORCE OBTAINED BY LINEAR INTERPOLATION ON TABF. SIZE (NF). 


c 

XDD 

= ACCELERATION. 

SIZE (NX). 

c 

XD 

= VELOCITY. 

SIZE (NX). 

c 

X 

= DISPLACEMENT. 

SIZE (NX). 

c 

AIDF 

= A^^-l^feD^F. SI 

ZE (NX). (WRITTEN ON PAPER ONLY). 


NERROR EXPLANATION 

1 = SIZE EXCEEDANCE. 

2 = start TIME LESS THAN TABLE BOUNDS. 

3 = END TIME GREATER THAN TABLE BOUNDS. 

4 = RUN HAS DIVERGED. 


2001 FORMAT 
1 
2 
3 
A 

2040 FORMAT 
2050 FORMAT 
2060 FORMAT 

♦ 

2250 FORMAT 


(////I5X,43H THE INPUT SCALARS TO SUBROUTINE TRSPlb ARE « 
//23X, lOH STARTT = F10.6, 

//23Xt lOH DELTAT = F10.6, 

//23X, lOh ENDT = F10.6t 

//23X, lOH NWRITE = 15 ) 

{//0X,8H TIME = FlO.fr) 

C//9X,15H APPLIED FORCES / IlOX, 5E16.8)) 

{// 9X»4H ROW, 6X,13H ACCELERATION, 8X,9H VELOCITY, 
10X,13H DISPLACEMENT, 4X,19H ♦ 0 ♦ FORCES // 

CieX, 13, 4E2Q.8I) 

(/ IX 123(1H~) ) 


IF (NX .GT. 250 .OR. NF .GT. 500) GO TO 999 


N6RR0R=1 


PRINT INPUT SCALARS. 

IF (MINI ,NE, 4HK1NI) GO TO 10 

IF (NLINE .LE. 5 .OR. NLINE .GE. MAXLIN) GO TO lO 
IF ((NLlNr^2+13> .GT. MAXLIN) GO TO 10 
WRITE (NOT, 2250) 

NLINE = NLINE 2 
GO TO 11 

10 CALL PAGE HO 

11 WRITE (r4GT,2G01) STARTT, DELTAT, ENDT,NWRITF 
NLINE = NLINE + 13 


SEARCH NTAPE FOR END OF WRITTEN DATA. 

REWIND NTAPE 

5 READ (NTAPE) BUFIN, GUF IN, I ECTCK, (BUFIN, 1=1 ,5 ) ,NREC 
IF (lEOTCK ,E0. 3HE0T) GO TO 7 

DO 6 IPEC=1,NREC 

6 READ (NTAPE) 

GO TO 5 

7 BACKSPACE NTAPE 


CHECK TIME TABLE (TABT). 
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DO 18 I=1tNF 

NERR0R=2 

IF (START! .LT. TABT(I,1») GO TO 999 
DO 12 J=2,NTF 

IF (TABT(I,J-1) .GE. TABT(I,J)) GO TO 14 
12 CONTINUE 
J = NTF+1 

14 IF (ENDT .LE. TABT(I,J-1)) GO TO 18 

NERR0R=3 

GO TO 9^9 
18 CONTINUE 
C 

C CALCULATE NUMBER OE TIME POINTS TO BE USED. 

NTP = (ENDT-STaRTTI/DELTAT "+ l.l 
C 

t SET INITIAL VALUES. 

WRITE (NTAPEI IRUNNO, XNAME*DATEfSTARTT,DELTAT,ENOT,NXtNF*NTP, 

♦ (BUF,Isl,10) 

NW = NWRITE 

T = START! 

DO 80 1=1 »NX 
OD(I) = 0.0 
Q (I) = 0.0 
XD(I) = XDO(I) 

80 X (I) = XO (I) 

DP 86 1=1 tNF 
DO 84 J=1 ,NTF 

IF (T .LE. TABT(1,J+1) .OR. ( J+1 I .EO.NTF) C TO 86 
84 CONTINUE 

86 F(I) = TABF(I,J) + (T~TABT( I , J I) ♦ (TABFf I, J+1 l-TABFC I , J)l / 

♦ (TABT(I,J+ll~TABT(l*jn 

DO 96 1=1 ,NX 
SS = ZERO 
DO 94 J=1 ,NF 
S = D(I,J)*F(J) 

94 SS = SS + S 

96 AIDE(I) = SS 
DO 97 1=1, NX 

97 XDD(I) = AIDFdl 
DO 99 1=1 ,NX 
SS = ZERO 
DO 98 J=1,NX 
S = B(I,J)#XD(J» 

SS = SS + S 
S = C(I,J»^X(JI 

98 SS = SS ♦ S 

99 XDD(I) = XDD(I) - SS 

SET INTEGRATION CONSTANTS. 

P(l) = .5 

P(2) = 1. - $QRT(.5) 

P(3) = 1. ♦ S0RT(.5) 

P(4) = ,b 

INTEGRATION LOOP. IK=1,HALF STEP), (K=2,HALF STEP AGAIN), 
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CK=3,FULL STEP), CK=A,ENO OF STEP). 

GILL FACTOR = .5 



DO 

30 <) ITP=1, 

NTP 




IF 

(ITP .FO. 

1) GO TO 340 



DO 

150 K=l,4 





DO 

110 1=1, NX 





Z 


XD (I) * 

DELTAT 




ZD 

- 

XDD(I) * 

DELTAT 




IF 

CK 

.EQ. 4) 

GO TO 105 




R 


P(K) * ( 

Z -Q (D) 




RD 


P(K) ’t: ( 

ZD-QDI I) ) 




GO 

TO 

107 




105 

R 

= 

(Z - 2. 

#0 (I))/6. 




RD 


(ZD - ?. 

♦0D( I) )/6. 



107 

X 

f 1) 

= X (I) 

♦ R 




XDI I) 

= XD(I) 

4- RO 




Q 

(I) 

= 0 (I) 

+ 3.*R - 

P(K 

)*Z 

110 

QDII) 

= OD(I) 

♦ 3.4RD - 

P(K 

)*ZD 


IF 

(K 

.NE. 11 

GO TO 115 




T = T + .5*DELTA7 
GO TO 130 

115 IF (K .NE. 3) GO TO 140 

T = STAPTT + FLOAT! ITP-1)*DEL TAT 
130 DO 136 1=1 ,NF 
DO 134 J=1,NTF 

IF n .LE. TABT(I,J+1) .OR. (J+D.EQ.NTF) GO TO 136 
I 134 CONTINUE 

136 FdJ = TABF(I,J) + IT-TABT( I, J ) ) * ITABFI I , J+1 )-TABF ( I , J ) ) / 

* (TABT(I,J+1)-TABT(I,J) ) 

140 DO 146 1=1, NX 

SS = ZERO 
DO 144 J=1,NF 
S = 0(I,J)*F(J) 

144 SS = SS ♦ S 

146 AIDF(I) = SS 
DO 147 I=1,NX 

147 XDOm = AIDF(l) 

DO 149 1=1, NX 

SS = ZERO 
DO 14P J=1,NX 
S = B(I,J)4XD(J) 

SS = SS ♦ S 
S = CII,J)*X(J) 

148 SS = SS ♦ S 

149 XDD( I) = XDD(I) ~ SS 

150 CONTINUE 
C 

C WRITE ANSWERS ON NTAPE FOR LATER USE. 

340 WRITE (NTAPE) T, (F(I),I=1,NI ), (XDDC I) ,1=1 ,NX ) , (XDI I ) ,1=1 ,NX) , 

♦ (X(l ),I = 1,NX) 

C 

■ SEE IF DATA SHOULD BE PRINTED. 

IF (ITP.LT.NTP .AND. NW.LT.NWRITE ) GO TO 345 
NFL = NF/5 

IF ((NFL»5) .NE. NF ) NFL = NFL+1 
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IF (MINI .NE. 4HMINII GO TO 800 

IF (NLINE .LE. 5 .OR. NLINE .GE. MAXLINI GO TO 900 
IF ((NLlNE+2<^3+3+NFL+4+NXI .GT. MAXLINI GO TO 800 
WRITE (NOT, 2250) 

NLINE = NLINE + 2 
GO TO 810 
800 CALL PAGEHD 
810 WRITE (NOT, 20401 T 

WRITE (NOT, 2050) (F(I), I=1,NF) 

NLINE = NLINE + 3 + 3 ♦ NFL 
NXS = 1 
NXE = NX 

NFLN = (NF-1 1/54^1 

IF ((NXE + NFLN) .GT. (NLPP-15)) NXE= (NLPP-15 l-NFLM 

342 WRITE (NOT, 2060) (I, XDD(I), XD(I), X(I), AlOF(l), 1=NXS,NXE) 
NLINE = NLINE ♦ 4 ♦ (NXE-NXS+1 ) 

IF (NX .EC. NXE) GO TO 343 
NXS = NXE + 1 
NXE = NX 

IF ((NXE-NXS) .GT. (NLPP- 9)) NXE=NXS+(NLPP- 9) 

CALL PAGEHD 
GO TO 342 

343 NW = 0 
345 NW = NW+1 

C 

SEE IF RUN HAS DIVERGED. 

NERR0R=4 

00 350 1=1, NX 

IF (ABS(X(D) .GT. DIVTOL) GO TO 999 
350 CONTINUE 
C 

399 CONTINUE 
C 

WRITE (NTAPEI BUF ,BUF ,EOT , ( BUF,I=1 , 16) 

ENDFILE NTAPE 
RETURN 
C 

999 ENDFILE NTAPE 

CALL ZZBOMB ( 6HTRSP1B ,NERROR) 

END 
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SUBROUTINE TRSPIC (B,C,Dt FMAGfPP,VEL,GLt XDO.XOtSTARTT.OELTATt 

* ENOT,NWRITE,NX,NF,XNAME,KA,NTAPEI 
DIMENSION B(KA,1) ,C (K A« 1 ) ,0 (KA«1 ) »FMAG( 1 1 tPP( 1 > t 

* XOO(l),XO(ll 
DIMENSION P(A) 

COMMON /LWRKVl/ XDO C2*>0 I , XD *250 1 
COMMON /LWPKV2/ 00(2501,0*250) 

COMMON /LWRKV3/ X * 250 ) , AIOF *250 ) 

COMMON /LWRKVA/ F*500) 

COMMON /L START/ IRUNNO,DATE .NPAGE ,UNAME 13 ) .TITLEl 1 12 ) »TirLE2 * 12 ) 
COMMON /LLINE/ NL INE,MAXL IN ,M'IN1 
DOUBLE PRECISION S,5S,ZER0 
DATA 2EP0/0.D/ 

DATA NIT,NCT/5,6/ 

DATA NLPP,BUF,OIVTOL, PI , EOT/ 

* 54 , 0.,1.E^35,3.1415927,3HE0T/ 

C 

C THIS MODIFICATION OF TRSPl USES (1-COS 1/2 FORCING FUNCTION (LIKE 
C TRSPl A) AND ASSUMES COEFFICIENT OF XOO IS UNITY SO THAT ONE LESS 
C MATRIX SPACE IS REQUIRED THAN TRSPIA. 

C RESPONSE ROUTINE TO SOLVE THE SECOND ORDER DIFFERENTIAL EQUATION 
C XOO ♦ (P*|X0 ♦ (OX = (DIF FOR XDD, XO, X. 

C FOURTH ORDER RUNGE-KUTTA (GILL MODIFICATION) NUMERICAL INTEGRATION 
C IS USED. 

C THE FORCING FUNCTION, F , IS A SINGLE PERIOD *l-C0S)/2 FUNCTION 
C BEGINNING AT T=STARTT AND FORWARD PP. THE COORDINATES ARE FORCED 
j. SIMULTANEOUSLY (SUDDEN ENVELOPMENT) IF VECTOR PP IS CONSTANT, OR AS 
'C A PENETRATING FUNCTION (EACH COORDINATE FORCE LAGS ITS PREDECESSOR 
C DEPENDING ON PENETRATION RATE AND STATION SPACING) IF VECTOR PP 
C IS NOT CONSTANT. 

C THE ANSWERS (T,F,XOD,XO,X) WILL BE WRITTEN ON NTAPE EVERY DELTA! AND 
C ON PAPER EVERY NWRITE ♦ DELTAT. 

C NTAPE MUST HAVE BEEN INITIALIZED WITH SUBROUTINE INTAPE. A HEADER, 

C TIME POINT DATA, AND END-OF-FILE WILL BE WRITTEN ON NTAPE HERE. 

C COMMON /LSTART/ IS DEFINED IN SUBROUTINE START. 

C INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

C CALLS FORMA SUBROUTINES PAGEHD ,Z2BOM6 . 

C THE MAXIMUM SIZES ARE (BASED ON DIMENSIONS OF XOD,XD,X,F| 

C NX = 250 

C NF = 500 

C CODED BY RL WOHLEN. FEBRUARY 1967. 

C LAST REVISION BY RL WOHLEN. MARCH 1976. 

C 

C SUBROUTINE ARGUMENTS (ALL INPUT) 

C B = MATRIX COEFFICIENT OF XO . SIZE (NX, NX). 

C C = MATRIX COEFFICIENT OF X. SIZE (NX, NX). 

CD = MATRIX COEFFICIENT OF F. SIZE *NX,NF). 

C FMAG = VECTOR OF COORDINATE FORCE MAGNITUDES SUBJECT TO (l-C0S)/2 

C VARIATION. SIZE(NF). 

C PP = VECTOR OF COORDINATE STATIONS, (CONSTANT IF SUDDEN 
C ENVELOPMENT) . POSITIVE DIRECTION FOR STATIONS IS OPPOSITE 

TO VEL DIRECTION. SIZE(NF). 

L VEL = PENF7RATI0N RATE. 

C GL = GUST LENGTH, PERIOD OF (l-C0S)/2 FUNCTION. 

C XDO = VECTOR OF INITIAL VELOCITIES. SIZE (NX). 
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r. XO = VECTOR OF INITIAL DISPLACEMENTS. SIZE (NX). 

I STARTT= START TIME. FORCING FUNCTION BEGINS- 
DELTAT= INTEGRATION STEP SIZE. 

ENDT = END TIME. 

NWRITE= MULTIPLE OF INTEGRATION POINTS TO WRITE ON PAPER. 

NWRITE = 1 WRITE E’/ERY POINT (I*2»3f...) 

NWRITE = 2 WRITE EVERY SECOND POINT (l,3v5«...) 

ETC 

NX = SIZE OF MATRICES B,C (SQUARE). NUMBER OF ROWS IN 0. MAX=250. 

NF = SIZE OF VECTOR FMAGt NUMBER OF COLS IN 0. MAX=500. 

XNAME = IDENTIFICATION OF DATA TO BE WRITTEN ON NTAPE. |A6 FORMAT). 

KA = ROW DIMENSION OF B,C*D IN CALLING PROGRAM. 

NTAPE = NUMBER OF TAPE ON WHICH ANSWERS WILL BE WRITTEN. (E.G. 10). 

THE OUTPUT DATA (TO BE WRITTEN ON PAPER AND NTAPE) IS 
T = TIME 

F = FORCE EVALUATED BY (I~CCS)/2 EXPRESSION, SIZE (NF). 

XDD = ACCELERATION. SIZE (NX). 

XD = VELOCITY. SIZE (NX). 

X = DISPLACEMENT. SIZE (NX). 

AIDF = A**-I*D*F. SIZE (NX). (WRITTEN ON PAPER ONLY). 

NERROR EXPLANATION 

1 = SIZE EXCEEDANCE. 

2 = RUN HAS DIVERGED. 

2001 EORMAT ( ////1 5X , A^3H THE INPUT SCALARS TO SUBROUTINE TRSPIC ARE , 


1 

//23X, 

lOH 

STARTT 

=• 

F10.6 

2 

//23X, 

lOH 

deltat 


F10.6 

3 

//23X, 

lOH 

ENDT 

= 

E10.6 

4 

//23X, 

lOH 

NWRITE 


15 

5 

//23X, 

ICH 

VEL 

= 

E15.8 

6 

//23X, 

lOH 

GL 

- 

E15.8 


2040 FORMAT (//PX,8H TIME = F10.6) 

2050 FORMAT (//9X.15H APPLIED FORCES / (lOX, 5EI6.8)) 

2060 FORMAT (// 9X,4H ROW, 6X,I3H ACCELERATION, 8X,9H VELOCITY, 

♦ 10X,13H DISPLACEMENT, 4X,19H A*»-I * 0 ♦ FORCES // 

♦ ( lOX, 13, 4E20.8) ) 

2250 FORMAT (/IX 123(1H~) ) 

NERR0R=1 

IF (NX .GT. 250 .OR. NF .GT. 500) GO TO 999 

PRINT INPUT SCALARS. 

IF (MINI .NE. 4HMINI) GO TO 10 

IF (NLINE .LE. 5 .OR. NLINE .GF. MAXLIN) GO TC 10 
IF ( (NLINF+2+17) .GT. MAXLIN) GO TO 10 
WRITF (NOT, 2250) 

NLINE = NLINE + 2 
GO TO 11 

10 CALL PAGEHD 

11 WRITE (NOT, 2001) STAR TT,DELTAT, ENDT, NWRITE, VEL,GL 
NLINE = NLINE ♦ 17 

SEARCH NTAPE FOR END OF WRITTEN DATA. 
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REWIND NTAPE 

5 READ (NTAPE) BUFIN, BUFIN, lEOTCK, (BUFIN, I=lt f» ) *NREC 
IF (IFOTCK .EO. 3HE0T) GO TO 7 

DC 6 lREC=^ltNREC 

6 READ (NTAPE) 

GO TO 5 

7 BACKSPACE NTAPE 
C 

C CALCULATE NUMBER OF TIME POINTS TO BE USED. 

NTP = (ENDT“STARTT)/DELTAT ♦ 1.1 
C 

C FIND FIRST STATION (FORWARD PP) TO ENTER GUST. 

FWDPP = PP(1) 

DO 50 1=1 ,NF 

IF (PP(I) .LT. FWDPP) FWDPP = PP(I) 

50 CONTINUE 
C 

C SET initial values. 

WRITE (NTAPE) IRUNNO, XNAME,OATE,STARTT,OELTATfENDT,NX*NFtNTP, 
♦ (BUFtI=ltlO) 

T = STARTT 
NW = NWRITE 
TPIGL = 2.*PI/GL 
DO 80 1=1 *NX 
OD(I) = 0.0 
0 (I) = 0.0 
XD(I) = XDO(I) 
tiO X (I) = XO (I) 

DO 84 1=1, NF 
84 F(I) =0.0 
DO 94 1=1, NX 
94 AlDF(l) = 0. 

DO 97 1 = 1, NX 

97 XDDd) = AIDF(I) 

DO 99 1=1 ,NX 

SS = ZERO 
DO 98 J=1,NX 
S = B(1,J)*XD(J) 

SS = SS + S 
S = C(I,J)*X(J) 

98 SS = SS + S 

99 XDD(I) = XDD(I) - SS 
C 

C SET INTEGRATION CONSTANTS. 

P(l) = .5 

P(2) = 1. - SORT( .5) 

P(3) = 1. + S0KT(.5) 

P(4) = .5 
C 

C INTEGRATION LOOP. (K=1,HALF STEP), (K=?,HALF STEP AGAIN), 

C (K=3,FULL STEP), (K=4,END OF STEP). 

GILL FACTOR = .5 
DO 399 ITP=1,NTP 
IF OTP .FQ. 1) GO TO 340 
DC 150 K=l,4 
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DO 

110 1=1 

,NX 






Z 

= XO (1 

) ♦ 

DELTAT 




ZD 

= XDD( I 

) ♦ 

DELTAT 




IF 

(K .FQ. 

4) 

GC 

1 TO 105 




R 

= P(K) 

♦ { 

Z - 

0 (D) 




RO 

= P(K) 

= ( 

ZD- 

QO(I) 1 




GO 

TO 107 






105 

R 

= (Z - 

2. 

♦0 

(1)1/6. 




RO 

= (ZD - 

2. 

♦QO(I) )/6. 



107 

X 

(I) = X 

(I) 


R 




XD 

(I) = XD(I) 


RD 




0 

(I) = 0 

(I) 


3.*R - 

P(K 

)*Z 

110 

QD(I) = 0D(1) 


3.»RD - 

P(K 

)^2D 


IF 

(K .NE. 

1) 

GO TO 115 




T = T + .5*DELTAT 
GO TO 130 

115 IF (K .NE. 3) GO TO 140 

T = ctaRTT ♦ FLCAT( ITP-1|*DELTAT 
130 FWDGPO = VEL=»(T-STARTT) 

DO 136 1=1, NF 
F(I) = 0.0 

GPD = FWDGf D •“ (PPCI)“FWOPP» 

IF (GPO.GT.0.0 .AND. GPO.LT .GL)F( I) =FMA&( I )♦« 1 .-COS?GPO>^TPIGL 11/2 . 
136 CONTINUE 
140 DO 146 1=1, NX 
SS = ZERO 
DO 144 J=1,NF 
S = 0(I,J)^F(J) 

144 SS = SS ♦ S 

146 AIDFUI = SS 
DO 147 1=1, NX 

147 XOb(I) = AIL. (I) 

DO 149 1=1, NX 

SS = ZERO 
DO 148 J=1,NX 
S = B(I,JI*XD(Jl 
SS = SS *5- S 
S = C(1,JI*X(J) 

148 SS = SS ♦ S 

149 XDDdI = XDDdI - SS 

150 CONTINUE 

WRITE ANSWERS C.'N NTAPE FOR LATFR USE. 

340 WRITE (NTAPE) T, (F (I ) , 1= 1 ,NF ) , ( XDOf I) ,1=1 ,NX ) , (XD( I ) ,1 = 1 ,NX) , 

♦ (X(I) ,I=1,NX) 

SEE IF DATA SHOULD BE PRINTED. 

IF (ITP.LT.NTP .AND. NW.LI .NWR ITE ) GO TO 345 
NFL = NF/5 

IF («NFL»5) .NE. NF ) NFL = NFL-»1 
IF (MINI .NF. 4HMINI) GO TO 800 

IF (NLINE .LE. 5 .OP. NLINE .GF. MAXLIN) GO TO BOO 
IF ((NLINE-^?^?+3+NFL*4+NX) .GT. MAXLIN) GO YD 800 
WRITE (NOT, 2250) 

NLINE = NLINE + 2 
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GO TP ?10 
800 CALL PACFFD 
810 WPITF (N07r20A0! T 

WRITF (NCT, 20501 I=1,NF» 

NLINE = NLINF ♦ 3 ♦ 3 •• NFL 
NXF = 1 
NXF = NX 

NFLN = (NF-n/5*l 

IF (<NXt + NFLN) .GT. INLPP-151) NXF= CNLPP-15 l-NFLN 

342 WRITE < NOT, 2060) Cl, XDDIl), XOII), XCI). AlOFfl), I=NXS,NXE’ 
NLINE = NLINE + 4 ♦ (NXE-NXS-.-D 

IF (NX .EC. NXE) GO TO 343 
NXE = NXE + 1 
NXE = NX 

IF (CNXF-NXS) .GT. (NLPP- 9)1 NXE=NXS+CNLPP- 91 
CALL PAGFHD 
GC TO 342 

343 NW = 0 
345 NW = NW+1 

C 

C SEE IF RUN HAS DIVERGED. 

NERR0R=2 

DC 350 1=1, NX 

IF (ABSCXCD) .GT. DIVTOL) GO TO 999 
350 CONTINUE 
C 

399 CONTINUE 

WRITE {NTAPE) 6UF ,BUF ,EOT, (BUF,I=1,16 ) 

ENDFILE NTAPE 
RE URN 
C 

999 ENDFILE NTAPE 

CALL ZZeOMB (6HTRSP1C ,NERROR) 

END 
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SUBROUTINE TRSP2 « A,B ,C *0 ,TaBT,TABF ,XOO •XO.STARTT ,OELTaT, ENDT, 

1 6FTA,NWRITL',NX,NF,NTF,XNAMF,KA,KF,NTAPE,NUT1I 

DIMENSION AfKA,l) ,F(KA,1I*C<KA,1),D(KA,1).TABHKF,1»,7ABF(KF,1I, 

* xoo(ij,xoni 

COMMON /LW0KV2/ XMl (250 I tXM2( 250 ) 

COMMON /LWRKV3/ X (25C ) ,XD (250 J 
COMMON /LWPKVA/ XPD (250 ) , F ( 250 ) 

COMMON /LWSKV5/ FMl (250 ) *FM2( 250 1 

COMMON /LSTART/ IPUNNO.DATF ,NPAGE tUNAME (3 l.TITLEl (121 ,TITLE2(12 1 
COMMON /LLINF/ NLINF,MAXLIN,MINI 
DOUBLE PRECISION StSS,ZERO 
DATA ZFRO/o.D/ 

DATA NII,NDT/5t6/ 

DATA NLPP,BUF,DIVTOL, EOT/ 

♦ 54 , 0.,1.E^35,3HECT/ 

C 

C RESPONSE ROUTINE TO SOLVE THE SECOND ORDER DIFFERENTIAL EQUATION 
C (A)XDD ♦ (BIXD ♦ (C»X = (D)F FOR XDO, XD, X. 

C THIRD ORDE'- NFWMAFK-CHAN-BETA NUMERICAL INTEWATION IS USED. 

C VECTOR F IS PPTAINED BY LINEAR INTERPOLATION USING TABT.TAEF. 

C MATRICES A»B,CtD SHOULD NOT SHARE SAME CORE LOCATION (DUE TO MULTfc). 

C THE ANSWERS (T,F ,XDD tXDt XI WILL BE WRITTEN ON NTAPE EVERY OELTaT AND 

c ON Paper every nwrite ♦ deltat. 

C NTAPE MUST HAVE BEEN INITIALIZED WITH SUBROUTINE INTAPE. A HEADER, 

C TIME POINT DATA, AND FNO-OF-FILE WILL PE WRITTEN ON NTAPE HERE. 

C common /LSTAPT/ IS DEFINED IN SUBROUTINE START. 

INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

C CALLS FORMA SUBROUTINES INVl ,ML'LT,MULTP,PAGEHO ,Z ZBC 
C THE MAXIMUM SIZES ARE (BASED ON DIMENSIONS OF XDO,Xt,X,F| 

C NX = 250 

C NF = 250 

C COOED BY RL WOHLEN. MAY 1965. 

C LAST REVISION BY RL WOHLEN. MARCH 1976. 

C 

C SUBROUTINE ARGUMENTS (ALL INPUTI 

C A = MATRIX COEFFICIENT OF XDO. SIZF (NX, NX). ♦ DESTROYED * 

C 6 = MATRIX COEFFICIENT OF XO. SIZF (NX, NX). * DESTROYED ♦ 

C C = MATRIX COEFFICIENT OF X. SIZE (NX, NX). » DESTROYED ♦ 

CD = matrix coefficient of F. size (NX,NF). ♦ DESTROYED ★ 

C TAPT = TABLE OF TIMES FOP FORCE IN TAPE. SIZE (NF,NTF). 

C tape = TABLE OF FORCES. SIZE (NF,NTF). 

C XDO = VECTOR OF INITIAL VELOCITIES. SIZE (NX). 

C XO - VECTOR OF INITIAL DISPLACEMENTS. SIZE (NX). 

C STARTT= START TIME. 

C DELTAT= INTEGRATION STEP SIZE. 

C ENOT = END TIME. 

C beta = PARAMETER OF GENERALISED ACCELERATION (BETWEEN .0 AND .25). 

C NWRITE= MULTIPLE OF INTEGRATION POINTS TO WRITE ON PAPER. 

C NWPI7F = 1 WRITE EVERY POINT (1,2,3,...) 

C NWRITE = 2 WRITE EVERY SECOND POINT (1,3,5,...) 

C ETC 

NX = SIZF OF MATRICES A,B,C (SQUARE). NUMBER CF ROWS IN 0. MAX=250. 
, NF = NUMBER OF ROWS IN TAPT jT ABF, NUMBER OF COLS IN D. MAX=25G, 

C NTF = NUMBER OF COLS IN TAPT,TABF. 

C XNAME = IDENTIFICATION OF DATA TO EE WRITTEN ON NTAPE. (A6 FORMAT). 
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r KA = ROW DIMENSION CF A,B,C,D IN CALLING PROGRAM. 

L KF - POW riMFNSION OF TABT.TABF IN CALLING PROGRAM. 

C NT APS = NUMBER CF TAPE ON WHICH ANSWERS WILL BE WRITTEN. (E.G. lOI. 
C NUTl = NUMBER GF THE UTILITY TAPE. (E.G. 

C 

C THE CUTPUT DATA (TO 6E WRITTEN CJK PAPER AND N TAPE I IS 

C T = TIME 

C F = FCFCE OBTAINED BY LINEAR INTERPOLATIOM ON TABF. SIZE (NF). 

C XOO = ACCELERATION. SIZE (NX». 

C XO = VELOCITY. SIZE (NXI. 

C X = DISPLACEMENT. SIZE (NX). 

C 

C NERRCR EXPLANATION 

C 1 = SIZE EXCEEDANCE. 

C 2 = START TIME LESS THAN TABLE BOUNDS. 

C 3 = END TIME GREATER THAN TABLE BOUNDS. 

C A = RUN HAS DIVERGED. 

C 

2001 FORMAT 

1 

2 

3 

4 

5 

204C FORMAT 
. 2050 FORMAT 
2060 FORMAT 
‘ 1 
2250 FORMAT 
C 

IF (NX 
C 

C PRINT INPUT SCALARS. 

IF (MINI .NE. 4HMINII GO TO 10 

IF (NLINE .LF. 5 .OP. NLINE .GE. MAXLIN) GO TO 10 
IF ( lMLINE+2+15) .GT. MAXLIN) GO TO 10 
WRITE (NOT, 2250) 

NLINE = NLINE ♦ 2 
GO TO 11 

10 CALL PAGEHD 

11 WRITE (NOT, 2001) START! ,DELTAT,ENDT , BETA, NWRITE 
NLINE = NLINE + 15 

C 

C SEARCH NTAPE FOR END OF WRITTEN DATA. 

REWIND NTAPE 

5 READ (NTAPE) EUFIN,6UFIN, lEOTCK, (BUFIN, 1=1,5 ) ,NREC 
IF (lEOTCK ,F0. 3HE0T) GO TO 7 
DO 6 1REC=1,NREC 

6 READ (NTAPE) 

GO TO 5 

7 BACKSPACE NTAPE 

C CHECK TIME TABLE (TABT). 

00 18 1=1, NF 


(////15X,42H THE INPUT SCALARS TO SUBROUTINE TRSP2 ARE , 


//23X, 

ICH 

START! = FI 0.6, 

//23X, 

lOh 

DELTA! = F10.6, 

//23X, 

lOH 

ENDT = Flo. 6, 

//23X, 

lOH 

BETA = F10.6, 

//23X, 

lOH 

NWRITE = 15 


(//PX,8H TIME = Flo. 6) 

(//VX,15H APPLIED FORCES / ( lOX, 5E16.8)) 

(// RX,4h ROW, 6X,13H ACCELERATION, 8X,9H VELOCITY- 
10X,13H DISPLACEMENT // (lOX, 13, 3E20.e)) 

(/ IX 123(1H-) ) 

NERR0R=1 

.GT. 250 .OR. NF .GT. 250) GO TO 999 
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IF fSTAPTT .LT. TABT<I,in GO TO 999 
DO 12 J=2,NTF 

IF fTART(I*J-ll .GE. TABTCI.Jll GO TO 14 
12 CONTIMUF 
J = NIF+1 

14 IF CENOT .LE« TABT(1,J-1II GO TO 18 

GO TO 990 
18 CONTINUE 
C 

C CALCULATE NUMPEP OF TIME POINTS TO BE USED- 
NTP = (ENDT-STARTTl/DELTAT + 1.1 
C 

C CALCULATE A»^-1»C* A**~1^D. 

REWIND NUTl 

WRITE (NUTl) ((B(I«J), 1=1, NXl, J=1,NX1 
CALL INVl lA, B, NX, KAI 
00 45 J=1,NX 
DC 45 1=1, NX 
45 ACI,J» = pn,ji 
REWIND NUTl 

READ (NUTl) ((B(1,J), 1=1, NX), J=1,NX) 

CALL MULTP (A, B, NX, NX, NX, KA, KA ) 

CALL MULIF (A, C, NX, NX, NX, KA, KA) 

CALL MULTB (A, D, NX, NX, NF, KA, KA ) 

C CALCULATE INITIAL FORCE(F), ACCELERATION (XOO I- 
00 55 1=1, NF 
DO 53 J=1,NTF 

IF (STAPTT .LF. TAET(I,J+1| .OR. ( J+1 » .EO.NTF ) GO TO 55 
53 CONTINUE 

55 FMl(I)=TABF(I,j; + (STARTT-TABT(I,jn * ( TABF ( I , J*1 |-TABF{ I , J I ) / 
1 (TABTCl,J+l)-TABT(I,jn 

DO 66 1 = 1, NX 
SS = ZERO 
DO 65 J=1,NF 
S = D(1 ,J)*FM1(J) 

65 SS = SS + S 

66 XDD(I) = SS 
DO 69 1=1, NX 
SS = ZERO 

DC 68 J=1 ,NX 
S = B(1 ,J)*XDO(J) 

SS = SS ♦ S 
S = C(1 ,J)*XO(J) 

68 SS = SS ♦ S 

69 XDO(I) = XDD(l) - SS 
C 

C WRITE HFADFR AND ANSWERS AT START ON NTAPE FOR LATER USE. 

WRITE ( NTAPE ) IRUNNO, XN AME ,OATE ,STARTT,DE LTAT,ENDT,NX ,NF,NTP, 

♦ (FUF,I=1,10) 

/ WRITE (NTAPE) STARTT, ( FMI ( 1 ) ,I =1 , NF) , (XDD ( I ) , 1=1 ,NX ) , 

* (XDO( 1) ,I=1,NX) , (X0( I) ,I=1,NX) 

C 
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PRINT DATA AT START. 

NFL = NF/5 

IF ((NFL*5I .NE. NF ) NFL = NFL+1 
IF (MINI ,NE. 4HMINII GO TO 70 

IF INLINE ,LE. 5 .DR. NLINE .GE. MAXLIN} GO TO 7© 

IF ( (NLINE+2+3+3+NFL4-44-NXI -6T. MAXLIN) GO TO 70 
WRITF (NOT, 2250) 

NLINF = NLINE ♦ 2 
GO TO 71 

70 CALL PAGEHD 

71 WRITE (NOT, 2040) STARTT 

WRITE (NOT, 2050) (FMl(I), I=ltNF) 

NLINE = NLINE + 3 3 ♦ NFL 

NXS = 1 
NXE = NX 

NFLN = (NF-D/5+1 

IF ((NXF + NFLN) .GT. (NLPP-15)) NXE=(NLPP-15 )-NFLN 

82 WRITE (NOT, 2060) ( I ,X DO ( I ) ,X00( I ) ,X0( I) , I=NXS,NXE) 

NLINE = NLINE ♦ 4 ♦ ( NXE-NXS+1) 

IF (NX ,EQ. NXE) GO TO 83 
NXS = NXE ♦ 1 
NXE = NX 

IF (INXE-NXS) ,GT. (NLPP- 9)) NXE=NXS+(NLPP- 9) 

CALL PAGEHD 
GO TO 82 

83 NW = 1 

P 

C CALCULATE SCALAR CONSTANTS FOR INTEGRATION- 
C1 = OELTAT / 2. 

C? = (.5 - FETA) * DELTAT=*^2 
C3 = (.2 5- BETA) ♦ DELTAT^=»^3 
C4 = FETA # DELTAT**2 
C5 = 1,/DFLTAT 
C6 = l./DELTAT*#2 
C7 = -2. + l./RETA 
C8 = (1. - 2.*BETA) ♦ DELTA T«*2 

CALCULATE AT START TIME + DELTA TIME. 

T = STARTT + DELTA! 

DO 05 1=1 ,NF 
DC 93 J=1 »NTF 

IF (T .LE. TABT(I,J+1) .OR. (J+1 ) .EQ.NTF ) GO TO 95 
93 CONTINUE 

95 F(l) = TABF(I,J) ♦ (T-TABT(I,J)) ♦ (TABFI I , J+1 )-TAPF ( I , J ) ) / 
♦ (TABT(I,J+1)-TABT(I,J) ) 


REWIND NUTl 

WRITE (NUTl) ((B(I,J), 1=1, NX), J=1,NX) P=AIP 

WRITE (NUTl) ((DII,J), 1=1, NX), J=1,NF) D=AID 

WRITE (NUTl) ((C(I,J), 1=1, NX), J=1,NX) C=AIC 

CALL MULT I B ,C , A, NX ,NX, NX ,KA,KA ) A=A1BAIC 

DO 101 I=I,NX 
DC 100 J=1,NX 

■ 100 A(I,J) = C1*B(I,J) - C2»C(I,J) - C3>FA(I,J) 

101 A(I,I) = 1. + A(1,I) A=P 

DO 111 1=1, NX 
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DO 110 J=1,NX 

110 = Cl*Bn,J! ♦ C4*C(I,JI 

111 = 1. + B<1*I) 

CALL TNVl (B,C*NX»KA) 

WRITE (NLITI) ((C(I,J), 1 = 1, NX 1, J=1,NX) 

CALL MULTB (C ,A,NX,NX,NX,KA,KA) 

CALL MULT ( A,XO,XMI ?NX,NX,1 ,KA,KA 1 
REWIND NUTl 

READ (NUTl) ((B(I,J), I=1,NX), J=1,NX) 

Call mult (b,e,a,nx,nx,nx,ka*kai 

DO 1?1 1=1, NX 
DC 120 J=1,NX 

120 A(I,JI = -C3*A(I,J) 

121 A(I,I) = OELTAT ♦ A(I,II 

CALL MULTB (C, A,NX,N X,NX ,K A,KA I 
CALL MULT ( A,XOO, XM2 ,NX, 1 ,KA,K A) 

CALL MULTP (C ,D,NX ,NX,NF ,KA,KA) 

Call mult (0,f,em2,nx,nf,i,ka,kf) 

DC 131 1=1, NX 
DO 130 J=1,NX 

130 B(I,J) = C3*B(I,J) 

131 B(I,I> = r? ♦ BU,I) 

CALL MULTB (C,B ,NX,NX,NX ,KA,KA) 

READ (NUTl) ((D(I,J), 1=1, NX), j=l,NF) 

CALL MULTB ( P ,D ,NX,NX,NF ,KA, KA) 

CALL MULT ( D,FM1,X,NX,NF, 1,KA,KF ) 

DO 140 1=1, NX 

X(I) = XMKI) + XM2(I) ♦ CA*FM2(I) ♦ X(I) 

140 XD (I) = C5 (X(l) - XO(D) 

REWIND NUTl 

READ (NUTl) ((B(I,J), 1=1, NX), J=1 ,NX) 

READ (NUTl) ((DU,J), 1=1, NX), J=1,NF) 

READ (NUTl) (!C(I,J), I=1,NX ) , J=1 ,NX) 

DC 146 1=1, NX 
SS = ZERO 
DO 144 J=1,NF 
S = 0(I,J)»F(J) 

144 SS = SS ♦ S 
146 XDD(l) = SS 
DC 149 1=1, NX 
SS = ZERO 
DO 148 J=1,NX 
S = B(I,J)*XD(J) 

SS = SS + 5 
S = C(I,J )*X( J) 

148 SS = SS + S 

149 XDD(l) = XDD(I) - SS 
C 

C CALCULATE CONSTANT COEFFICIENT MATRICES FOP TIME T2,T3,ETC. 
00 151 1=1, NX 
DO 150 J=1,NX 

150 E(I,J) = -C8*C(1,J) 

151 B(I,I) = 2, ♦ B(I,1) 

READ (NUTl) ((A(I,J), 1=1, NX), J=1,NX) 

CALL MULTB ( A,B,NX ,N X,NX ,K A,KA ) 


B = S 
C=S1 

A=SIP 

XM1=AX0 

B=A1B 

A=AlBAlfi^ 


A=C 

A=SIQ 

XM2=AXDC 

D=SIAID 

FM2=DF1 


B=R 

e=SIR 

D=AID 

0=SIRAI0I 

X=OFO 


XD=XD1 

B=AIB 

D=AID 

C=AIC 


B=T 

A=S1 

B=SIT 
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REWIND NUT1 

READ INUTi) lfA(I,J), 1=1, NX), J=1,NX) 

A=AIB 

160 

DO 161 I=1,NX 
DO 160 J=1,NX 

CI1,J) = -C1*AII,J) ♦ C4*CII,J) 


161 

CII,I) = 1. + C(I,II 

C=U 


READ 'NUTl ) 

READ (NUTl) 

READ INUII) {(AI1,J), 1=1, NX), J=1,NX) 

A=SI 


CALL MULTE 1 A,C ,NX ,NX,NX ,KA,KA) 

C=SIU 


CALL MULTB ( A,D,NX,NX,NF,KA,KA ) 

D=SIAID 

180 

DO 180 1=1, NX 
DO 160 J=1,NF 
DI1,J) = C4«0II,J) 


185 

DC 185 1=1, NX 
XMIII) = XOIl) 



CALCULATE X,XO,XOD FOR TIME = T2,T3,ETC. 

DO 39<» 1TP=?,NTP 
IF (ITP .EO. 2) GO TO 3AO 
DO 191 1=1, NX 
XM2(I) = XMl(I) 

191 XMim = X (It 

or 1P2 1=1, NF 
FM2(1) = FMKI) 

192 FMKI) = F (I) 

T = START! ♦ FLOAT(nP-l)*DELTAT 

DO 194 1=1, NF 
DO 193 J=1,NTF 

IF <T .LE. TABT(I,J+11 .OR. {J+1).EC*NTF) GO TO 194 

193 CONTINUE 

194 F(I) = TABF(1,J) ♦ (T-TABTU,J)) * ITABF C I, J+1 )-TA8F 1 1 , J I ) / 

* (TABT(I,J+l)-TABT(I,„*n 

DC 201 J=1,NF 

201 FM2(J) = F(J) ♦ C7>FFMHJ) ♦ FM2(J) 

DO 206 1=1, NX 
SS = ZERO 
DO 204 J=1,NF 
S = Dl I,J)*FM2(J) 

204 SS = SS ♦ S 

206 X( I) = SS 

DO 20B 1=1, NX 
SS = ZERO 
DO 207 J=1,NX 
S = B(I ,J KXMKJ) 

SS = SS + 5 
S = C(I ,J)*XM2CJ) 

207 SS = SS - S 

208 XI I) = XII) ♦ SS 
DO 209 1=1, NX 

XD m = C5 * ixm - XMIII )) 

209 XDDin = C6 =* cxm ~ 2. ♦XMIII) + XM2ID) 

WRITE ANSWERS ON NT APE FOR LATER USE. 
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3A0 WRITE (NTAPE) T, IF ( I ) , 1 =1 ,NF ) , (X00( I) •!=! *NX ) « (XOI I ) ,1=1 «NX) • 
* 1X111,1=1, NX) 

SEE IF DATA SHOULD BE PRINTED. 

IF (ITP.LT.NTP .AND. NW .LT.NWRITE ) GO TO 345 
NFL = NF/5 

IF l(NFL*5) .NE. NF ) NFL = NFL+1 
IF (MINI .NE. 4HMINI) GO TO 800 

IF INLINE .LE. 5 .OR. NLINE .GE. MAXLIN) GO TO 800 
IF l(NLINF+2+3+3+NFL-»-4+NXI .GT. MAXLIN) GO TO 800 
WRITE (NOT, 2250 
NLINE = NLINE 2 
GO TO 810 
800 CALL PAGEHD 
810 WRITE (NOT, 2040 T 

WRITE (NOT, 2050) (F(I), 1=1,NF) 

NLINE = NLINE + 3 + 3 ♦ NFL 
NXS = 1 
NXE = NX 

NFLN = INF-D/5 + 1 

IF ((NXE ♦ NFLN) .GT. (NLPP-15) ) NXE= lNLPP-15 )-NFLN 

342 WRITE (NOT, 2060) (I, XDO(I), XOII), XII), I=NXS,NXE) 

NLINE = NLINE + 4 ♦ INXE-NXS+1) 

IF (NX .EC. NXE) GO TO 343 
NXS = NXE + 1 
NXE = NX 

IF (INXE-NXS) .GT. INLPP- 9)) NXE=NXS+(NLPP- 9) 

CALL PAGEHD 
GO TO 342 

343 NW = 0 
345 NW = NW+I 

SEE IF RUN HAS DIVERGED. 

NERR0R=4 

DO 350 1=1, NX 

IF (ABSIXID) .GT. DIVTOL) GO TO 999 
350 CONTINUE 

399 CONTINUE 
C 

WRITE INTAPE) BUF,eUF,EOT,IBUF,I=l, 16) 

ENDFILE NTAPE 
RETURN 
t 

999 ENDFILE NTAPE 

CALL ZZBOMB I6HTRSP2 ,NERROR) 

END 
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SUBROUTINE TRSP2A (A,B,C.D,FMAG,PP, VELfGL ,XOO ,XO» *^TARTT *OELTAT, 

* ENDT»BETA,NWRlTEtNX,NF,XNAME,KA,NTAPEtNUTl I 
DIMENSION AJKA,n ,e (KA»1I ,C IKA*1 1 »D (KA» 1 ) »FMAG( 1) ,PP(1) « 

* XDO m , XO ( 1 1 

COMMON /LWRKV2/ XMI (2 50 ) , XM2 f 250 } 

COMMON /LWPKV3/ X 1250 ) ,XD (250 ) 

COMMON /LWPKVA/ XDO (250 ) , F (250 ) 

COMMON /LWRKV5/ FMI (2 50 ) ,FM2 ( 250 1 

COMMON /L START/ IPUNN0,DATE ,NPAGE ,UMAME (3 J,TITLE1 (121 ,TITLE2(12 I 
COMMON /LLINF/ NLINE ,MAXLIN,MINI 
DOUBLE PRECISION StSS.ZLRO 
DATA ZFPO/0.0/ 

DATA NIT»N0T/5.6/ 

DATA NLPP,BUF,DIVTCL, PI « EOT/ 

* 54 ♦ 0.,l.E-*^35, 3. 1415927, 3HE0T/ 

C 

C THIS MODIFICATION OF TPSP2 USES (1-COS 1/2 FORCING FUNCTION- 
C RESPONSE ROUTINE TO SOLVE THE SECOND ORDER DIFFERENTIAL EQUATION 
C (AIXDD ♦ (P)XO + (CIX = (DIF FOR XDD, XD, X. 

C THIRD ORDER NE WMARK-CH AN-BETA NUMERICAL INTEGRATION IS USED. 

C THE FORCING FUNCTION, F , IS A SINGLE PERIOD (l-COSI/2 FUNCTION 
C BEGINNING AT T=STARTT AND FORWARD PP. THE COORDINATES ARE FORCED 
C SIMULTANEOUSLY (SUDDEN ENVELOPMENT) IF VECTOR PP IS CONSTANT, OR AS 
C A PENETRATING FUNCTION (EACH COORDINATE FORCE LAGS ITS PREDECESSOR 
C DEPENDING ON PENETRATION RATE AND STATION SPACING) IF VECTOR PP 
C IS NOT CONSTANT. 

MATRICES A,B,C,D SHOULD NOT SHARE SAME CORE LOCATION (DUE TO MULTB). 
C THE ANSWERS (T ,E ,XDD ,X0, X ) WILL BE WRITTEN ON NTAPE EVERY OELTAT AND 
C ON PAPER EVERY NWRITE ♦ DELTAT. 

C NTAPE MUST HAVE BEEN INITIALIZED WITH SUBROUTINE INTAPE. A HEADER, 

C TIME POINT DATA, AND END-OF-FILE WILL BE WRITTEN ON NTAPE HERE. 

C COMMON /LSTART/ IS DEFINED IN SUBROUTINE START. 

C INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

C CALLS FORMA SUBROUTINES INVl ,MUL T, MULTB, PAGEHD ,ZZEOMB. 

C THE MAXIMUM SIZES ARE (BASED ON DIMENSIONS OF XDD,XO,X,F) 

C NX = 250 

C NE = 250 

C COOED BY RL WOHLEN. MAY 1965. 

C LAST REVISION BY PL WOHLEN. MARCH 1976. 

C 

C ALL SUBROUTINE ARGUMENTS ARE INPUT 

C A = MATRIX COEFFICIENT OF XDD. SIZE (NX, NX). ♦ DESTROYED ♦ 

C B - MATRIX COEFFICIENT OF XD. SIZE (NX, NX). ♦ DESTROYED ♦ 

C C = MATRIX COEFFICIENT OF X. SIZE (NX, NX). ♦ OESTROYID » 

CD = MATRIX COEFFICIENT OF F. SIZE (NX,NF). ♦ DFSTROYED * 

C FMAG - VECTOR OF COORDINATE FORCE MAGNITUDES SUBJECT TO ( 1-COS )/2 
C VARIATION. SI2F(NF). 

C PP = VECTOR OF COORDINATE STATIONS, (CONSTANT I" SUDDEN 
C ENVELOPMENT ) . POSITIVE DIRECTION FOR STATIONS IS OPPOSITE 

C TO VFL DIRECTION. SIZE(NF). 

C VEL = PENETRATION RATE. 

GL = GUST LENGTH. PERIOD OF ( 1-COS )/2 FUNCTION. 

. XOO - VECTOR OF INITIAL VE1.0CITIFS. SIZE (NX). 

C XO = VECTOR OF INITIAL DISPLACEMENTS. SIZF. (NX). 

C STARTT= START TIME. FORCING FUNCTION BEGINS. 
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OELTAT= INTEGRATION STEP SIZE. 

ENDT = END TIME. 

BETA = PARAMETER OF GENERALISED ACCELERATION (BETWEEN .0 AND .251. 
NWRITE= MULTIPLE OF INTEGRATION POINTS TO WRITE ON PAPER. 

NWPITE = I WRITE EVERY POINT 

NWRITE = 2 WRITE EVERY SECOND POINT (1,3,5,...) 

ETC 

NX = SIZE OF MATRICES A,B,C (SQUARE). NUMBER OF ROWS IN D. MAX=250- 

NF = SIZE OF VECTOR FMAG, NUMBER OF COLS IN D. MAX=250. 

XNAME = IDENTIFICATION OF DATA TO BE WRITTEN ON NTAPE. (A6 FORMAT). 

KA = ROW DIMENSION OF A,B,C,D IN CALLING PROGRAM. 

NTAPE = NUMBER OF TAPE ON WHICH ANSWERS WILL BE WRITTEN. (E.G. 10). 
NUTl = NUMBER OF THE UTILITY TAPE. (E.G. A). 

THE OUTPUT DATA (TO BE WRITTEN ON PAPER AND NTAPE) IS 
T = TIME 

F = FORCE EVALUATED BY (l-C0S)/2 EXPRESSION, SIZE (NF). 

XOD = ACCELERATION. SIZE (NX). 

XO = VELOCITY. SIZE (NX). 

X = DISPLACEMENT. SIZE (NX). 

NERROR EXPLANATION 

1 = SIZE EXCEEDANCE. 

2 = RUN HAS DIVERGED. 

2001 FORMAT (////I 5X , ASH THE INPUT SCALARS TO SUBROUTINE TRSP2A ARE , 


1 

//23X, 

lOH 

STARTT 


F1C.6, 

2 

//23X, 

lOH 

DELTAT 


F10.6, 

3 

//23X, 

lOH 

ENDT 


F10.6, 

A 

//23X, 

?0H 

BFTA 


Flo. 6, 

5 

//23X, 

lOH 

NWRITE 


15 , 

6 

//23X, 

lOH 

VEL 

- 

E15.8, 

7 

//23X, 

lOH 

GL 

=: 

E15.8 ) 


20A0 FORMAT (//9X,8H TIME = F10.6) 

2050 FORMA! (//9X, 15H APPLIED FORCES / (lOX, 5E16.8)) 

2060 FORMAT (// <>X,AH ROW, 6X,13H ACCELERATION, 8X,9H VELOCITY, 

1 10X,13H DISPLACEMENT // (lOX, 13, 3E20.8) ) 

2250 FORMAT (/ IX 123(1H-) ) 

NERR0R=1 

IF (NX .GT. 250 .OR. NF .GT. 250) GO TO 999 

PRINT INPUT SCALARS. 

IF (MINI .NE. AHMINl) GO TO 10 

IF (NLINE .LE. 5 .OR. NLINE .GF. MAXLIN) GO TO 10 
IF ((NLINF+2+19) .GT. MAXLIN) GO TO 10 
WRITE (NOT, 2250) 

NLINE = NLINE ♦ 2 
GO TO 11 

10 CALL PAGEHD 

11 WRITE (NOT, 2001) START! ,DELTAT,ENDT, BETA, NWRITE ,VEL,GL 
NLINE = NLINE ♦ 19 


C SEARCH NTAPE FOR END OF WRITTEN DATA. 
REWIND NTAPE 
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5 READ (NTAPFI PUF1N,PUFIN, lEOTCK, (BUFINt 1=1*51 *NREC 
IF CIFOTCK .EO. 3HE0T) GO TO 7 

DO 6 1PFC=1,NREC 

6 READ (NTAPEI 
GO TO 5 

7 BACKSPACE NTAFE 

CALCULATE NUMBER OF TIME POINTS TO BE USED. 

NTP = (ENDT-STARTTI/DELTAT + 1.1 


CALCULATE A**^-1»B* A«»-1*C* A^*-1*D. 

REWIND NUTl 

WRITE (NUTII ((B(I,J), I=1*NXJ, J=1*NXI B=B 

CALL INVl JA* B, NX, KA ) B=A1 

DO A5 J=1 ,NX 
DO 45 1=1, NX 

45 A(I*J) = Pn,J) A=AI 

REWIND NUTl 

READ (NUTIJ ((B(I,J), 1=1, NX), J=1,NX| B=B 

CALL MULTB (A, B, NX, NX, NX, KA, KA) B=AIB 

CALL MULTE (A, C, NX, NX, NX, KA, KA ) C=AIC 

CALL MULTB (A, 0, NX, NX, NF , KA, KA I D=AID 


FIND FIRST STATION IFORWARD PP) «0 ENTER GUST. 

FWDPP = PPll) 

DP 50 1=1, NF 

IF (PP(T) .LT. FWDPP) FWDPP = PP(I) 

50 CONTINUE 

TPIGL = 2.^P1/GL 

CALCULATE INITIAL FORCE (F), ACCE LERATION (XDO ) . 

DO 55 1=1 ,NF 
55 FMl(I) = 0. 

DO 1=1, NX 
SS = ZERO 
DO 68 J=1 ,NX 
S = Bn,J)*XDO(J) 

SS = SS + S 
S = C( I ,J )*XO(J) 

68 SS = SS + S 

69 XDD(I) = XDD(I) - SS 

WRITE HFADFR AND ANSWERS AT START ON NTAPE FOR LATER USE. 

WRITE (NTAPE) IRUNNO, XNAME,DATE,STARTT,DELTAT,ENDT,WX,NF,NTP, 

♦ (PUE,I=1,10) 

WRITE (NTAPE) STARTT, ( FM 1 ( I ) , 1 = 1 ,NF) , <XDO ( I ) , 1=1 ,NX ) , 

♦ (XDo( I) ,I=1,NX) , CXOC I) ,I=1,NX) 

PRINT DATA AT START. 

NFL = NF/5 

IF ((NFL*5) .NE. NF ) NFL = NFL+1 
IF (MINI .NF. 4HMINI) GO TO 70 

IF (NLINE .LE. 5 .OR. NLINE .GE. MAXLIN) GO TO 70 
IF ( (NLlNF+2+3+3-»^NFL+4+NX) .GT. MAXLIN) GO TO 70 
WRITE (NOT, 2250) 
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NLINF = NLINE + 2 
GO TO 71 

70 CALL PAGE HO 

71 WRITE (NOTt20AOI STARTT 

WRITE (NOT, 2050) (FMl(I), 1=1, NF) 

NLINE = NLINE + 3 + 3 ♦ NFL 
NXS = 1 
NXE = NX 

NFLN = (NF-D/5 + 1 

IF ((NXE + NFLN) .GT. (NLPP-15)) NXE=(NLPP-15 )-NFLN 

82 WRITE (NOT, 2060) ( I ,XOD( I ) ,XDO( I) ,X0( I) • I=NXS,NXE) 

NLINE = NLINE ♦ 4 (NXE-NXS+1) 

IF (NX .EQ. NXE) GO TO 83 
NXS = NXE + 1 
NXE = NX 

IF ((NXe-NXS) .GT. (NLPP“ 9)) NXE=NXS^( NLPP- 9) 

CALL PAGE HD 
GO TO 82 

83 NW = 1 

CALCULATE SCALAR CONSTANTS FOR INTEGRATION. 

Cl = OELTAT / 2. 

C2 = (.5 - BETA) * DELTAT**2 

C3 = (.25- BETA) * OELTAT 

CA = BETA * 0ELTAT*42 

C5 = l./DELTAT 

C6 = l./DFLTAT**2 

C7 = -2. + l./BETA 

C8 = (1. - 2.*BETA) ♦ DELTAT=J‘*2 

CALCULATE AT START * iE + DELTA TIME. 

T = START. + DEL TAT 
FWDGPO = VEL*(T-STARTT) 

DC 95 1=1, NF 
F»I ) =0.0 

GPD = FWDGPD - (PP( D-FWDPP ) 

IF (GPD. GT. 0.0 .AND. GPD. LT.GL ) F( I ) =FMAG< 1 )*( l.-COS (GPD*TP IGL ) ) /2 
95 CONTINUE 
REWIND NUT! 

WRITE (NUTl) ((B(I,J), 1=1, NX), J=1,NX) 

WRITE (NUTl) ((D(1,J), 1=1, NX), J=1,NF) 

WRITE (MUTl) ((C(I,J), 1=1, NX), J=1,NX) 

CALL MULT ( B ,C - A,NX ,NX ,NX ,KA,KA ) 

DO 101 1=1, MX 

DO 100 J=1,NX 

100 A(I,J) = C)*B(I,J) - C2*C(I,J) - C3=^A(I,J) 

101 A(I,I) = 1. ♦ A(I,I) 

DO 111 1=1, NX 

DO no J=1,NX 

110 P(I,J) = C!*B(I,J) + C4*C(I,J) 

111 B(I,I) = 1. + B(l,l) 

CALL INVl (P,C,NX,KA) 

WRITE (NUTl) ((C(1,J), 1=1, NX), J=1,NX) 

CALL MULTB ( C , A ,NX ,NX ,NX ,K A, KA ) 

CALL MULT ( A,X0 ,XMl ,NX,NX ,1 ,KA,KA ) 


G=AIP 
D = A1D 
C=AIC 
A=AIBAIC 


A=P 


B=S 

C=SI 

A = SIP 
XM1=AX0 
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REWIN»D NUTl 

READ (WTIS n&n,J), I = l,NX)t J-ltNX) E^^AIB 

CALL MULT ( B ,B , A,NX ,NX,NX ,KA,KAJ A=AI6Alb 

DO 121 1=1, NX 
DO 120 J=1,NX 

120 A(I,J» = -C3*A(I,J) 

121 An,I) = DELTA! + A(I,I) A=0 

CALL NULTB (C,A,NX,NX,NX,KA,KA| A=SI0 

CALL MULT < A,XD0,XM2,NX ,NX, 1,KA,KA) XM2=AXD0 

CALL MULTB (C ,D,NX,NX,NF,KA,KA) D=SIAID 

CALL MULT ( D, F, FM2, NX,NF, 1, KA,KF ) FM2=DF1 

DO 131 1=1, NX 

DC 130 J=1,NX 

130 B(I,J) = C3*B(I,J) 

131 Bn,I) = C2 + B=R 

CALL MULTB ( C ,P ,NX ,NX,NX ,K A, KA ) B=SIR 

READ (NUTl) nO(I,J), 1 = 1, NX), J=1,NF) D=AID 

CALL MULTB (P ,D , NX ,NX ,NF ,KA, KA ) D=SIPAID 

CALL MULT ( D , FM 1, X, NX,NF, 1 , KA,KF ) X=CFO 

DO 140 1=1, NX 

X(I) = XMl(I) ♦ XM2(I) ♦ C4^FM2(I) + X(l) X=X1 

140 XD (I) = C"^ ♦ (X(I) - XO(D) XD=XD1 

REWIND NUTl 

READ (NUTl) ((B(1,J), 1=1, NX), J=1,NX) B=AIB 

READ (NUTl) {(D(I,J), 1=1, NX), J=1,NF) D=A1D 

READ (NUTl) ((C(I,J), I=1,NX), J=1,NX) C=AIC 


DO 146 1=1, NX 
SS = ZERO 
DO 14A J=1,NF 
S = D(1,J)’>=F(J) 

144 SS = sf; + S 
146 XDD(I) = SS 
DO 149 1=1, NX 
SS - ZERO 
DO 14B J=1,NX 
S = B(I,J)*XD(J) 

SS = SS + S 
S = C(I,J)*X(J) 

148 SS = SS + S 

149 XDD(I) = XDD(I ) - SS 

CALCULATE CONSTANT COEFFICIENT MATRICES FOR TIME T2,T3,ETC. 


DO 151 1=1, NX 
DO 150 J=1,NX 

150 B(1,J) = -C8*C(1,J) 

151 B(I,n = 2. + pn,ll B = T 

READ (NUTl) ((A(I,J), 1=1, NX), J=1,NX) A=SI 

CALL MULTB ( A,B , NX ,NX ,NX ,K A, KA ) B=SIT 

REWIND NUTl 

READ (NUTl) ((A(I,J), 1=1, NX), J=1,NX) A=A1B 

DO 16) 1 = 1 , NX 

DO 160 J=1,NX 

160 C(I,J) = -C1*A(1,J) + C4*C(1,J) 

161 C(I,I) = 1. + C(I,I) C=U 

READ (NUTl) 
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RFAD (NU71) 

READ (NUTl) ((A(I,J), 1=1, NX), J=1,NX) A= I 

CALL MULTB ( A ,C ,lvX ,NX ,NX ,KA, KA ) C-i3U 

CALL MUtTP (A,0,NX,NX,NF,KA,KA» D=SIA1D 

DO 180 1=1, NX 
DO 180 J=1,NF 
180 D(I,J) = C4*D(I,J) 

DO 185 I=),NX 
185 XMl(I) = XO(I) 

C 

C CALCULATE X,XD,XDD FOR TIME = T2,T3,ETC. 

DO 399 ITP=2,NTP 
IF (ITP .FC. 2) GO TO 340 
DO 191 1 = 1, NX 
XM2(I) = XMl(l) 

191 XMl(I) = X (I) 

DO 192 7=1,KF 
FM2(I) - FMl(I) 

192 FMl (I) = F (I) 

T = STARTT + FLOAT( 1TP-1)*DELTAT 
FWDGPn = VFL4(T-STARTT) 

DO 195 1=1, NF 
F(I) = 0.0 

GPD = FWD&PD - (PP(l)-FWDPP) 

IF (GPD. GT. 0.0 .AND. GPD. LT .GL )F (I ) =FMAG( !)*U .-COSI (.PD=>TP1GL ) )/2 . 

195 CONTINUE 

DO 201 J=1,NF 

201 FM2(J) = F(J) + C7*FMHJ) + FM2CJ) 

DO 206 1=1, NX 
SS = ZERO 
DO 204 J=1,NF 
S = D(I,J)*‘^M2(J) 

204 SS = SS ♦ S 

206 X(I) = SS 
DO 208 1=1, NX 
SS = ZERO 
DC 207 J=1,NX 
S = R(I,J)*XM1{J) 

SS = SS + S 
S = C(I,J )»^XM2(J) 

207 SS = SS - 5 

208 X(I) = X( I) ♦ SS 
CO 209 1=1, NX 

XD (I) = C.5 * (X(I) - XMKIH 

209 XDD(I) = Cb * (X(I) - 2.4XMKI) + XM2(IH 

WRITE ANSWERS ON NTAPE FOP LATER USE. 

340 WRITE (NTAPE) T, ( F ( I ) , I = 1, NF ) , ( XDD( 1) , 1=1 ,NX ) , (XD( 1 ) ,1 = 1,NX) , 

» (X(I),I=1,NX) 

SEE IF DATA SHOULD BF PRINTED. 

IF (ITP.LT.NTP .AND. NW.LT.NWRITE 1 GO TO 345 
NFL = NF/5 

IF ((NFL*E) .NE. NF ) NFL = NFL+1 
IF (MINI .NF. 4HMINI) CO TO 800 
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IF (NLINE .LF. 5 .OR. NLINE .GE. MAXLINI GO TO 800 
IF MNLIN'F>2+3*3+NFL+V+NXI .GT. MAXLINI GO TO GOO 
WRITE (NOT, 22501 
NLINf = NLINE ♦ 2 
GO TO eio 
800 CALL PAGEHD 
810 WRITE (N0T,20A0I T 

WRITE (NOT, 20501 (F(I|, 1=1, NFl 
NLINE = NLINE < 3 3 NFL 

NXS = 1 
NXE = NX 

NFLN = (NF-1)/5^1 

IF ((NXF ♦ NFLNI .GT. (NLPP-15M NXt=(NLPP-15 )-NFLN 

342 WRITE (NOT, 20601 (I, XOD(I), XD(I1, XCIl, 1=NXS,NXE1 
NLINE = NLINE ♦ 4 (NXE-NXS+ll 
IF (NX .ECU NXF: I GG TO 343 
NXS = NXE + 1 
NXE = NX 

IF ((NXE -NXS I .GT. (NLPP- 9)1 NXE=KXS+( NLPP- 9) 

CALL PAG'^Hb 
GO TO 342 

343 NW = 0 
345 NW = NW+1 

SEE IF RUN HAS DIVERGED. 

NERR0R=2 

00 350 1=1, NX 

IF (APS(X(in .GT. OIVTOLl GO TO 999 
350 CONTINUE 
C 

399 CONTINUE 
C 

WRITE (NT. Ptl BUF,eUF,EOT,f BUF,I=1,161 

ENOFILE NTAPE 

RETURN 

C 

999 ENOFILF NTAPE 

CALL ZZBCMB (6HTRSP2A ,NERRGR) 

END 
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SUBROUTINE TRSP3 (A ,B ,C .D ,TABT,TABF ,XOO ,XO, ST ARTT .DELTA! * ENDT, 

* NWRITE.NX.NF.NTF.XNAMF.KD.KF.NTAPE) 

DIMENSION AH ) ,B ( 1 1 ,C (1 ) ,D( KD ,1 ) ,TABT(K F, II ,TABF(KF.ll, 

* XDOdl.XOdI 

CPMMCN /LWRKVl/ XDD(250), XD(250) 

COMMON /LWEKV?/ X(250), TERKCPfOl 
COMMON /LWRKV3/ AIDED (2501, AIDF(250I 
COMMON /LWPKV4/ F(5U0) 

COMMON /LSI ART/ IRL’NNC.DATE .NPAGE .UNAME (3 1 .TITLEl ( 121 .T1TLE2 ( 12 I 
COMMON /LLINE/ NLINE.MAXL IN.MINI 
DOUELF PRECISION S.SS.2ER0 
DATA ZFRO/O.n/ 

DATA NIT, NOT/5, 6/ 

DATA NLPP.BUF.DIVTOL, EOT/ 

* 54 T 0.,1.E+35,3HE0T/ 

RESPONSf ROUTINE TO SOLVE THE SECOND ORDER DIFFERENTIAL EOUATION 
(AIXDD + (FIXO ♦ (OX = (DIF FOR XDD, XD, X- 
A, B, AND C ARE UNCOUPLED DIAGONAL MATRICES IN VECTOR FORM. 

CLOSED FORM SOLUTION IS USED TO FIND XDD, XO, AND X. 

VECTOR F IS CFTAINED BY LINEAR INTERPOLATION USING TABT.TABF. 

THE ANSWERS ( T,F ,XDD ,XD, X ) WILL BE WRITTEN ON NTAPE EVERY DELI AT AND 
ON PAPER EVERY NWRITE * DELTAT. 

NTAPE MUST HAVE BEEN INITIALIZED WITH SUBROUTINE INTAPE. A HEADER, 
TIME POINT DATA, AND END-OF-FILE WILL PE WRITTEN ON NTAPE HERE. 

COMMON /L'^TAPT/ IS DEFINED IN SUBROUTINE START. 

INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

CALLS FORMA SUBROUTINES PAGEHD .ZZBOMB . 

THE MAXIMUM SIZES ARE (BASED ON DIMENSIONS OF XOD,XD,X,F| 

NX = 250 
NF = 500 

THE MAXIMUM NUMBER OF UMOUE TIMES PAST STARTT IN TABT = 250. 

CODED BY WA PENFIFLD AND RL WOHLEN. FEBRUARY 19t>7. 

LAST REVISION BY RL WOHLEN, MARCH 1976. 

SUBROUTINE ARGUMENTS (ALL INPUT) 

A = MATRIX COEFFICIENT OF XDD. INPUT AS A VECTOR, 

USED AS A DIAGONAL MATRIX. SIZE (NX I. ♦DESTROYEO=i‘ 

B = MATRIX COEFFICIENT OF XD. INPUT AS A VECTOR, 

U<^FD AS A DIAGONAL MATRIX. SIZE (NX). ♦DESTROYED^ 

C = MATRIX COFFFICIENT OF X. INPUT AS A VECTOR, 

USED AS A DIAGONAL MATRIX. SIZF (NX). =frDF5TPOYEO» 

D - MATRIX COEFFICIENT OF F . SIZE (NX,NF|. ^DESTROYED* 

TABT = TABLf OF TIMES FOR FORCE IN TAPE. SIZE (NF.NTF). 

TABF = Table of fopces. size (nf.ntfi. 

XDO = VrCTOP OF INITIAL VELOCITIES. SIZF (NXI . *DESTROYtD* 

XO = VECTOR OF INITIAL DISPLACEMENTS. SIZE (NX). «DESTkOYL-0* 

STARTT - start TIME. 

DELTAT INTEGRATION TIME INTERVAL. 

ENDT = END TIME. 

NWRITE = MULTIPLE OF INTFGPATION POINTS TO WRITE ON PAPER. 

NWRITE = 1 WRITE EVERY POINT (1,2,3,...) 

NWRITE = 2 WRITE EVERY SECOND POINT (1,3,5,...) 

ETC 

NX = SIZE OF A, P, AND C (VECTORS). NUMBER OF ROWS IN 0. MAX=250. 
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NF = NUMBER PF ROWS IN TABT,TAPF. NUMBER OF COLS IN D. MAX=50G. 

NTF = NUMBER OF COLS IN TABT,TAPF. 

XNAME = IDENTIFICATION OF DATA TO PE WRITTEN ON NTAPE. (A6 FORMAT). 
KD = ROW DIMENSION OF D IN CALLING PROGRAM. 

KF = ROW DIMENSION OF TAPT, TAPE IN CALLING PROGRAM. 

NTAPE = NUMBER OF TAPE ON WHICH ANSWERS WILL PE WRITTEN. (E.G. 10). 

THE OUTPUT DATA CTO BE WRITTEN ON PAPER AND NTAPE) IS 
T = TIME . 

F = FORCE OBTAINED BY LINEAR INTERPOLATION ON TABF. SIZE (NF). 

XDD = ACCELEPATICN. SIZE (NX). 

XD = VELOCITY. SIZE (NX). 

X = DISPLACEMENT. SIZE (NX). 

AIDF = A=«==F-1=*^D=»F. SIZE (NX). (WRITTEN ON PAPER ONLY). 

NBPROR EXPLANATION 

1 = SIZE EXCEEDS DIMENSION. 

2 - START TIME LESS THAN TABLE BOUNDS. 

3 = END TIME GREATER THAN TABLE BOUNDS. 

4 = MORE Than 200 time breaks. 

2001 FORMAT (////15X.42H THE INPUT SCALARS TP SUBROUTINE TRSP3 ARE t 

1 //23X, lOH STARTT = F1C.6, 

2 //23X, lOH DELTAT = FI 0.6, 

3 //23X, ICH ENDT = FI 0.6, 

4 //23X, lOH NWRITE = 15 ) 

2040 FORMAT (//cx,BH TIME = E10.6) 

2050 FORMAT (//9X,15H APPLIED FORCES / (lOX, 5F16.8)) 

2060 FORMAT (// 9X,Ah ROW, 6X,13H ACCELERATION, 8X,9H VELOCITY, 

^ 10X,13H DISPLACEMENT, 4X,19H A*»-l * D ♦ FORCES // 

» ( ICX, 13, •^E20.8) ) 

2250 FORMAT (/ IX 123(1H-) ) 

NERR0R=1 

IF (NX .GT. 250 .OR. NF .GT. 500) GO TO 999 

PRINT INPUT SCALARS, 

IE (MINI ,NF. AHMINI) GO TO 10 

IF (NLINE .LE. 5 .OR. NLINE .GE. MAXLIN) GO TO 10 
IF ( (NLINE+2+12) .GT. MAXLIN) GO TO 10 
WRITE (NOT, 2250) 

NLINF NLINE + 2 
GO TO 11 

10 CALL PAGEHD 

11 WRITE (NOT, 2001) STAR TT, DELTAT, ENDT ,NWR ITE 
NLINE = NLINE + 13 

SEARCH NTAPE FOR END OF WRITTEN DATA. 

REWIND NTAPE 

5 RFAD (NTAPE) PUF 1 N ,EUF IN, IE OTCK , ( BUFIN, Ji=l, 5 ) ,NREC 
IF (lEPTCK .EQ. 3HECT) GO TO 7 

DO 6 lREf=l,NREC 

6 READ (NTAPE) 

GO TO 5 

7 BACKSPACE NTAPE 
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CHECK TIME TAELE (TABT). 

DO 18 1=1 ,NF 

NERROR=2 

IF (STARTT .LT. TABT(I,in GO TO 999 
DO 1? J=2»NTF 

IF fTAET(I,J-ll .GE« TABT(1,J1I GO TO 14 
12 CONTINUF 
J = NTF+1 

14 IF (ENDT .LE. TABT<1,J-1JJ GO TO 18 

NERRCR=3 

GO TO 909 
18 CONTINUE 

CALCULATE NUMEER OF TIME POINTS TO BE USED, 

NTP = (ENOT--SrARTT)/DELTAT 1,1 

CALCULATE CONSTANT.;. 

DO ^5 1=1, NX 
DO AO J=1,NF 
40 D(1,JI = 0(1,J1/A(II 
ASTCRE = .5=»'P<n/A( II 
C(II = C(I)/A(1) 

B(I) = SQFTfC (I|-AST0 RE=Mc2) 

45 A(I) = AS TORE 

A = DAMP/(?.:*^MASS) 

B = SORT (STTE/MASS - (DAMP/(2 .♦MASS)) A*2I 
C = STIF/MASS = 0MEGA*^2 

FIND UNIQUE TIME BREAKS (TBRK) IN TABT AFTER STARTT. MAX=250. 
NTBRK = C 
00 55 1=1 ,NE 
DC 54 J = 2,NTF 

IF (TABT<I,J) ,LE. STARTT) GO TO 54 
IF (TAPT(I,J-1) .GE. TAPTlIfJ)) GO TO 55 
IF <NTBRK .EO. 0) GO TO 52 
DO 50 K=1,NTBRK 

IF (TAPT(I,J) .EQ. TbRK(K)) GC TO 54 
50 CONTINUE 

52 NTBRK = NTBRK+1 

IF (NTBRK .LE. 250) GO TO 53 

NERR0R=4 

GO TO 

53 TBRK (NTBRK) = TAET(I,J) 

54 CONTINUE 

55 CONTINUE 

00 65 J=1 ,NTPPK 
DO 60 1=J, NTBRK 

IF (TBRK(I) .GE. TBRKIJ)) GO TO 60 
TMIN = TPRKII) 

TBRK (I) = TPRK(J) 

TE«K(J) = TMIN 
60 CONTINUF 
65 C0NT1?£UE 


0=AI0 
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SET INITIAL VALUES. 

WRITE (NTAPEl IRUNNC, XNAME,DATE,STARTTt DELTAT,ENOT,NXtNF,NTP, 
♦ (BUF, 1=1,1. 

T = STARTT 
TB = STARTT 
NW = NWRITE 
IB = 1 

DO 86 1 = 1, NF 
DO 8* J=1,NTF 

IF (T .LE. TABT(I,J+1) .OR. ( J+1 I .EC.NTF I GO TO 86 

BA continue 

86 F(l) = TAPE a, J) + tT“TABT!I,Jn * (TABF ( 1 , J+1 J-TABF U , J )) / 

^ <TABT(I,J+l)-TABT(I,jn 

DO 88 I = ! ,NX 
= ZERO 

DO 87 J=1 ,NF 
S = Dn,J)=^F(J) 

87 SS = SS + 5 

88 AIDF(I) = fS 
DC 90 1=1, NX 

90 AIOFOd) = AIDFdJ 
DO 95 1=1, NX 
X(I) = XOd) 

XD(I) = XDO(I) 

95 XDD(I) = AIDFO(I) - 2.*AUI»XD(1) - C(I)=»=X(II 

C INTEGRATION LOOP. 

DO 39«> ITP=1,NTP 
IF CITP .FO. 1) GO 10 390 
TX = STARTT + FL0AT{ITP-1»»DELTAT 
105 T = TX 

TMTB = T-TB 

c 

C SEE IF THEPF is a time BREAK (TB) IN TBRK BETWEEN PREVIOUS TIME 
C BREAK AND CURRENT TIME IT). 


IF 

IIB 

.GT. 

NTPRK) GO TO 390 

IF 

IT 

.LT. 

TPRKIIB)) GO TO 110 

T 

= 

TPRK 

(IB) 

TMTB = 

T-TB 


TP 

= 

T 


IE 

= 1 

E.+l 



110 DO 116 1=1, NF 
DO 113 J=1,NTF 

IF IT .LE. TABT(I,J+1) .OR. I J+1 ) . EQ .NTF ) GO TO 116 
113 CONTINUE 

116 FID = TABFII,J) ♦ IT-TABTII,J)) ♦ (TAB F 1 1 , J+1 )-TAE F 1 1 , J ) ) / 

♦ |TABTI1,J+1)-TABTII,J) ) 

DO 118 I=T,NX 
SS = ZERO 
00 117 J=1,NF 
S = DII,J)=«'FIJ) 

117 SS = SS + S 

118 AIDF(I) = SS 
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CALCULATE RESPWSE DUE TO DISPLACEMENT, VELOCITY, FORCE AT 
PREVIOUS TAFT BREAK AND DUE TO CURRENT RAMP. 

DO 125 1=1, NX 

PS = (AIDF{I»-AlUFO(in/TMTB 

IF (C(I) .EC. 0.0) GO TO 120 

6T = F(1)>«=TMT6 

SI = SINIPTI 

Cl = COS (FT) 

ASl = A(I)*S1 

eCl = P(I)*C1 

EAE = FXP(-Atl)*TMTB)/fc(l) 

XOEAF = aG(I)*EAB 

XDOEAB = XDO(T)«EAF 

X(I) = XOEAP^(ASl+eCl ) ♦ XD0EA5*S1 

1 + AIDFOd )=M1.-EAB*(AS1+BC1))/C(I) 

2 + PS*(TMTE ♦ (-2.*A(I )^EAE*IIAC I)*»2-B(I)**2)*S1 

3 +2.*A{I)*BC1))/C(I) )/C(I) 

XDd) =-XOEAB»Cd»*Sl XOOFAB*(-ASI-^8C1) + A1DF0( 1 )TEABTS1 
1 + RS«d.-EAP*(A51+eCl))/C(I) 

XDOd) = XOEAP^f d)»(ASl-FCl ) 

1 + XDOEAE*( (A( I)=«'*2-E( I)**2)’^S1-2.*A(I )4=BC1) 

2 ♦ AlDFOd )*EAB*(-AS1+BC1) + RS’t'EAB^Sl 

GO TO 125 

120 Xd) = XOd) ♦ XDO(I)*TMTB + .5>^AI0F0 d )=»=TMTB’M^2 ♦ RS=»TMTBT*3/6. 
XDd) = XDO(l) ♦ AlDFOd)*TMTB .5TRS=>TMTB*=«^2 
XDD (I) = AIDFOd) + RS<^TMTB 
125 CONTINUE 

IE (T .GT. TP) GO TO 340 
DO 130 1=1, NX 
XO(I) = Xd) 

XDOd) = XOd) 

130 AIDFOd) = AIDFd ) 

IF (T .LT. TX) GO TO 105 
C 

C WRITE ANSWERS ON NT APE FOR I AT EP USE. 

340 WRITE (NTAPE) T, (F d ) , 1 = 1, NF ) , ( XDOd ) , 1=1 ,NX ) , (XDd ) ,1 = 1, NX) , 

♦ (X(I),I=1,NX) 

C 

C SEE IF DATA SHOULD PE PRINTED. 

IE (ITP.LT.NTP .AND. NW.LT.NWRITE ) GO TO 345 
NFL = NF/5 

IF ((NFL*5) .NE. NE ) NFL = NFL+1 
IF (MINI .NE. 4HMINJ) GO TO 800 

IF (NLINE .LE. 5 .OR. NLINE .GE. MAXIIN) GO TO 800 
IF ((NL1NF+2+3+3+NFL+4+NX) .GT. MAXLIN) GO TO 800 
WRITE (NOT, 2250) 

NLINE = NLINE + 2 
GO TO PIO 
BOO CALL PAGEHD 
81C WRITE (NCT,204C) T 

WRITE (NOT, 2050) (Ed), I = 1,NF) 

NLINE = NLINE + 3 ♦ 3 ♦ NFL 
NXS = 1 
NXE = NX 

NFLN = (NF-D/5+1 
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IF <(NXf ♦ WFLN) .6T« INLPP-15)! NXE= fNLPP~15 )-NFLN 

342 WRITE (NOT, 20601 (I, XDDd), XO(l), X(I), AIDF(I), I=NXS,NXEJ 
NLINE = NLINE ♦ 4 ♦ (NXE-NXS+1 ) 

IF (NX .EQ. NXE) 60 TO 343 
NX? = Nxe + 1 
NXE = NX 

IF ((NXF-NXS) .61. (NLPP- 9H NXE=NXS+( NLPP- 9) 

CALL PAGEHD 
60 TO 342 

343 NW = 0 
345 NW = NW+1 

C 

399 CONTINUE 
C 

WRITE (NTAPf) BUF,BUF,£CT,(eOF,I=l,16| 

ENDFILE NTAPE 
RETURN 

C 

999 FNOFILE NTAPE 

CALL 2ZBCMB (6HTRSP3 ,NERRCRJ 
END 
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SUFRCUTINE UMAMl ( A.RBM.UMAM ,N,NRBM,K» 

DIMENSIC'N A(Kfl)f RBM(K,Ut UMAM(Ktl)* Wl(6«6}» W2(6t6) 

GENERATE TRANSFCRMAl ION RELATING INERTIA PLUS APPLIED LOADS TO 
APPLIED LOADS FOR INERTIALLY RESTRAINED SYSTEM. 

CALLS FORMA SUBROUTINES BABT.BTABtlNVl ,MULTB,PAGEHDtZZBOMB. 

THE MAXIMUM SIZES ARE 

N = 500 t BASED ON BTAB»MULTBI 
NRBM = 6 

DEVELOPED EY CARL BODLEY. JANUARY 1965. 

LAST REVISION BY WA BENFIELD. MARCH 1976. 

SUBROUTINE ARGUMENTS 
A = INPUT MASS MATRIX. SIZE(N,NI. 

RBM = INPUT MATRIX OF RIGID BODY MODES, (NEEDNT BE ORTHORNORMALI 
SIZE(N,NREMI. 

UMAM = OUTPUT (UNITY MINUS A MESS). SIZE(N,N). 

N = INPUT SIZE OF SYSTEM (NtJMBEP C»F COORDINATES). 

NRBM = INPUT NUMBER OF RIGID BODY MODES. MAX=6 . 

K = INPUT ROW DIMENSION OF A, RBM, UMAM IN CALLING PROGRAM. 

NFRROR EXPLANATION 
1 = MORE THAN 6 RIGID BODY MODES. 


IF (NRBM .GT. 6) GO TO 999 


NERROR=l 


CALL BTAB 
CALL INVl 
CALL PAPT 
CALL MULTB 
DO 60 1=1, N 
DO 50 J=1,N 
50 UMAM(I,J) = 
60 I’MAMd,!) = 
RETURN 


( A,RPM,W1 ,N,NRBM,K,6) 
(W1,W2,NRBM,6) 

(W2, REM, UMAM, N,NRPM, 6,K) 
(A, UMAM, N,N,N, K,K) 


-UMAM(I,J) 

1.0 + UMAM(I,1) 


C 


999 CALL ZZBOMB (6HUHAM1 ,NERROR) 
END 
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SUBROUTINE UNITY (ZtN.KR) 

DIMENSION ZCKRfll 

generate a unity matrix. (ONES ON THE DIAGONALI. 

CODED BY RL WOHLEN. FEB 1965. 

SUBROUTINE ARGUMENTS 

Z = OUTPUT MATRIX GENERATED. SIZECN,N). 

N = INPUT SIZE OF MATRIX Z (SQUARE). 

KR = INPUT ROW DIMENSION OF MATRIX Z IN CALLING PROGRAM. 

DO 20 1=1, N 
DO 10 J=1,N 
10 Z(I,J) = 0.0 
20 Z(1,I) = l.O 
RETURN 
END 
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SUBROUTINE UPDATE 


C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 
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c 

c 
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c 

c 
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UPDATE TAPE PROGRAM (PROGRAMMED TO WORK WITH DISK UNITS I 
MAXIMUM SIZE = AOOOO ELEMENTS FOR A DENSE MATRIX. 

CALLS FORMA SUBROUTINES ... NONE USED. 

CODED BY RF HRUDA. APRIL 1969. REVISED NOVEMBER 1970. 
MODIFIED FOR CONTRACT NASe-25922* MAY 1971. 


INPUT 


CARD 1 
CARD 2 
CARD N 


1FINTT,TAPEID,NT1,NT2 

LNS,LNE 

10 ZEROS (REST OF CARD BLANK) 


FORMAT (2A6,I3«I5) 
FORMAT (215) 

FORMAT (110) 


VARIABLES 


IFINIT = INITIL t NT2 WILL BE INITIALIZED AND UPDATE WILL 

START AT BEGINNING OF NT2. 

= NOINIT , UPDATE WILL BEGIN AT END OF DATA ON NT2. 

= STOP f PROGRAM WILL BE STOPPED. 

TAPEIO = TAPE I.D. FOR TAPE THAT IS TO BE INITIALIZED (EG T1234). 

NTl = LOGICAL NUMBER OF THE TAPE TO BE READ FRCW (EG 11). 

NT2 = LOGICAL NUMBER OF THE TAPE TO BE WRITTEN ON (EG 10). 

LNS = STARTING LOCATION NUMBER OF AN UPDATE BLOCK. 

LNE - ENDING LOCATION NUMBER OF THE UPDATE BLOCK. 

= 0, INDICATES END OF TAPE. 

(MATRICES WITH LOCATION NUMBERS LNS THRU LNE WILL BE UPDATED) 


EXAMPLE OF INPUT DATA FOR SUBROUTINE UPDATE. 


CARD COLUMN NUMBER 
I 2 

12345678901234567890 COMMENTS. 


UPDATE FROM 11 ONTO 10 AND INITIAL 10 AS T1234. 
UPDATE FROM MATRIX 5 THRU MATRIX 9, 

UPDATE ONLY MATRIX 2, 

UPDATE FROM MATRIX 19 THRU END OF TAPEIO. 

RETURN TO CALLING PROGRAM. 

UPDATE FROM 12 ONTO 10 (IF REQD) 

14 24 

3 7 

9 12 

0000000000 
STOP 

BETA-CARD. 


1N1TILT1234 11 10 

5 9 

2 2 

19 0 

0000000000 

NOINIT 12 10 
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DIMENSION AC40000) 

DATA NIT,NC!T/5*6/ 

DATA ZtNSMAX* EOT, IDENSE/ 
♦ 0. ,40000, 3HE0T,5HDENSE/ 

DATA NLPP/54/ 


1001 FORMAT 

1002 FORMAT 

2001 FORMAT 

2002 FORMAT 

2003 FORMAT 
*■ 

2004 FORMAT 

♦ 

♦ 

♦ 

2005 FORMAT 

2006 FORMAT 

2007 FORMAT 

2008 FORMAT 
♦ 

♦ 

3001 FORMAT 
♦ 

3002 FORMAT 
* 

♦ 

4c 


(2A6,I3,15) 

(2151 

(IHl 47X 6HUPDATE 21X 8HPAGE NO. 13) 

(/ 26X35HLISTING OF MATRICES ON LOGICAL UNITI3,7H, T'^PE A6 ) 
(/ 20X35HLISTING OF MATRICES ON LOGICAL UNITI3,7H, TAPE A6, 
12H (CONTINUED)) 

( 26X 5K1H-) / 27X3HN0.3X7HRUN N0.4X4HNAME5X5HNR0WS 

4X5HNC0LS4X4HDATE/ 

27X3H 3X6H 4X6H 4X5H 

4X5H 3X6H /) 

( 25XI5,3XA6,4XA6,3XI5,4XI5,4XA6) 

(/ 27X 14HEND OF UPDATE.) 

(//27X AIHTHF FOLLOWING DATA WAS UPDATED FROM TAPE A6 /) 

( 2CX 63(1H-) / 27X3HN0.3X7HRUN N0.4X4HNAME5X5HNR0WS 
4X5 HNC0LS4X4H DATE/ 

27X3H 3X6H 4X6H 4X5H 

4X5H 3X6H /) 

(//27X 42HTHE FOLLOWING INPUT DATA WAS NOT EXECUTED, 

/ 32X 5HLNS = 15, 5X 5HLNE = 15, 

/ 27X 35HUPDATE CONTINUES FOR REST OF INPUT./) 

(//27X 42HMAX SIZE EXCEEDED IN THE FOLLOWING MATRIX, 

/ 25X 15, 3XA6,4XA6, 3X15, 4X15, 4XA6, 

/ 27X 28HTHIS MATRIX WAS NOT UPDATED. 

/ 27X 38HUPDATE CONTINUES FOR REST OF MATRICES./) 


READ IN HEADER CARD AND INITIALIZE CONSTANTS. 

READ (NIT, 1001) IF1MT,TAPE I0,NT1,NT2 

IF (IFINIT .EQ. 4HST0P) STOP 

LNl = 0 

LN2 = 1 

NPAGF = 1 

WRITE (NOT, 2001) NPAGE 

REWIND TAPES, DEFINE NTl TAPEID, AND INITIALIZE NT2 IF NECESSARY. 
REWIND NTl 
REWIND NT 2 
READ (NTl) Tl 
REWIND NTl 

IF (IFINIT .NE. 6HINITIL) GO TO 111 
WRITE (NT2) TAPEID, LN2, EOT, (Z, 1*1,16) 

REWIND NT 2 
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LIST ANY EXISTING MATRICES ON T2. 

111 READ (N72) T2 
REWIND NT2 

WRITE (NOT, 20021 NT2,T2 
WRITE (NOT, 2004) 

NLINF - 1 
GO TO 113 

112 NPAGE = MPAGE+1 
WRITE (NOT, 2001) NPAGE 
WRITE (NOT, 2003) NT2,T2 
WRITE (NOT, 2008) 

NLINE = 1 

113 read (NT2) T2,LN2,1FOTCK,IRUNNO,ANAME,NR,NC,IDATE 
IF (lEOTCK .EO. 3HE0T) GO TO 116 

READ (NT. > 

IF (IRUNNO .EQ. ICHK) GO TO 115 
ICHK = IRUNNO 
NLINE = NLINE+1 
WRITE (NOT, 1001) 

115 WRITE (NOT, 2005) LN2, IRUNNO ,ANAME, NR, NC , IDA TE 
NLINE = NLINE+1 

IF(NLINE .GT. (NLPP-7)) GO TO 112 
GO TO 113 

116 BACKSPACE NT2 
WRITF (NOT, 2007) T1 
NLINE = NLINE+4 


READ IN DATA CARD AND POSITION Tl. 

200 READ (NIT, 1002) LNS,LNE 
IF (LNS.EO.O) GO TO 500 
IF (LNS.LT.O) GO TO 401 
LNEl = LNF 

IF (LNEl .LT.LNS) LNEl = 9000 
NMATS = LNFl-LNS+1 
IF (LNS.EO.LNl+1) GO TO 300 
IF (LNS.GT.LNl+1) GO TO 201 
REWIND NTl 
LNl = 0 

201 NUM = LNS-LNl-1 

IF (NUM.FC.O) GO TO 300 

DO 202 N0=1,NUM 

READ (NTl) Tl ,LN1 ,1E0TCK 

IF (lEPTCK .EQ. 3HE0T) GO TO 401 

202 READ (NTl ) 

UPDATE A BLOCK OF NMATS MATRICES FROM Tl ONTO T2. 
300 DO 305 N=l, NMATS 

IF(NLINE .LT. (NLPP~7)) GO TO 301 

NPAGE = NPAGE+1 

WRITE (N0T,?001) NPAGE 

WRITE (NOT, 2003) NT2,T2 

WRITE (NOT, 2008) 
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NLINE = 1 

301 READ (NTl ) T1 ,LN1 ,1 EOTCK, IR UNNO» ANAME tNRtNC»IOATE 
IF (lEOTCK ,E0. 3HECT) GO TO ?00 

IF nCHK .EO. IRUNNO) GO TO 302 
NLINE = NLINt+1 
WRITE <N0T,100l) 

ICHK = IRUNNO 

302 NS = NR*NC 

IF (NS.GT.NSMAX) GO TO 304 

WRITE IMT2) T2»LN2,2. IRUNNO, ANAMEfNR,NCtIDATEtIDENSE, (2*1*1,101 
READ (NTl) (A(I ) ,I=1,NS) 

WRITE (NT2) (A(I),I*1,NS) 

WRITE (NOT, 2005) LN2, IRUNNO,ANAME ,NR,NC ,IDATE 
LN2 = LN2+1 
NLINE = NLINE+1 
GO TO 305 

304 WRITE {NOT, 3002) LNl , IRUNNQ,ANAME ,NR,NC ,IDATE 
READ (NTl) 

NLINE = NLINE+8 

305 CONTINUE 
GO TO 200 


ERROR MESSAGE. 

401 WRITE (NOT, 3001) LNS.LNE 
REWIND NTl 
LNl = 0 

NLINE * NLINE+5 
GO TO 200 

END OF UPDATE. 

500 WRITE (NT?) T2,LN2,EOT, (Z ,1=1 ,16) 
ENDFILE NT? 

REWIND NT? 

WRITE (NOT, 1001) 

WRITE (NOT, 2005) LN2,E0T 
WRITE (NOT, 2006) 

RETURN 

END 
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SUBROUTINE UTAUl C A,U, Z,N,KRA,KRU,KR 2 1 
DIMFNS’ON A(KPA,1 »,U(KRU,J» ,Z<KR2,1I 
COMMON / LWRKVl / V 15 00 I 
DOUBLE PRECISION SUM, SS. ZERO 
DATA ZERO /O.D/ 

UTAUl PERFORMS THE OPERATION iZ 1 = C (b ITRANSPCSE)* CAl»<U I 
WHERE U IS AN UPPER TRIANGULAR MATRIX . 

UTAUl CAN ALSO PERFORM THE OPERATION 

(AH=C(U)TRANSPOSE)*(AI*(U) BY CALL UTAU1(A,U,A, — ETC — I . 

IE N IS NEGATIVE A SYMMETRIC (Z» IS COMPUTED. 

MAXIMUM SIZE N=500 

INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

FORMA SUEROUTINE 2ZF0ME TS CALLED. 

COOED BY JOHN ADMIRE »NAiA* AUG 1^72 . 

LAST REVISION BY RL WOHLEN. APRIL 1976. 

ARGUMENTS 

MATRIX (A) SIZECN BY N) 

UPPER TRIANGULAR MATRIX «U1 SIZE IN BY N) 

MATRir tZ) SIZEIN BY N) 

ABS(N? NUMBER OF ROWS AND COLUMNS IN lAl, (UI AND (2) 

ROW DIMENSION OF (A) IN CALLING PROGRAM 

ROW DIMENSI?N PE (U| IN CALLING PROGRAM 

ROW DIMENSION OF (2) IN CALLING PROGRAM 

NERROR EXPLANATIONS 
1 SIZE EXCEEDANCE. 

NN=1A6S(N) 

NERROR = 1 

IFINN .GT. 500 ,PR. NN .GT. KRA .OR. f'iN .GT. KRU 
♦ .OR. NN .GT . KR2I GO TO 999 
DO 30 1=1, NN 
OP 10 K=1,NN 
10 V(KI=A(1,K» 

DO 30 J=1,NN 
SUM=ZERO 
DO 20 K=1 ,J 
SS=V(K)*U(K,J) 

20 SUM :SUM+SS 
30 ZII,J)=SUM 

IF(N .GT. 0 ) GO TO 70 
DO 60 J=1,NN 
DO 40 K=1 , J 
40 V(K)=Z(K,J) 

DP 60 1=1, J 
SUM=2EP0 
DO *^0 K = l,l 
5S = U(K,n*V(K» 

50 SUM=SUM+SS 


A - INPUT 
U - INPUT 
Z - OUTPUT 
N - INPUT 
KRA - INPUT 
KFU - INPUT 
KR2 - INPUT 



UTAUl 


60 Z(I,J»=SUM 
DO 63 I=ltNN 
00 63 J-ItNN 
63 Z( 

RETURN* 

70 DO 100 J=ltNN 
DO 80 K=l,NN 
80 VCK)=2(K,J) 

DO 100 1=1, NN 
SUM=ZERC 
DO 90 K=1,I 
SS=U(K,n*V(K) 

90 SUM=SUM+SS 
100 2<I,J)=SUM 
RETURN 

999 CALL 2ZB0MB(6HUTAU1 ,NERRDRI 
END 



r>r>rtnoor>or. nnonoonoonnonoononono 


UTAUCl — 1/ 2 


SUBROUTINE UTAUCl IA,U,C*Z,N,KRA»KRU*KRC ,KR2I 
DIMENSION A(KRA,lIfU(KRU«i),CCKRCf n*Z(KRZ,lt 
COMMON / LWPKVl / V<500l 
DOUBLE PRECISION SUM,SS,ZERO 
DATA ZERO /O.O/ 

UTAUCl PERFORMS THE OPERATION ( Z )=(( U» TRANSPOSE) >►< A l»fU| +(CI 
WHERE tUI IS AN UPPER TRIANGULAR MATRIX . 

UTAUCl CAN ALSO PERFORM THE OPERATIONS 

( AI = nUITRANSPOSE)*(A)»<U) + (C) BY CALL UTAUCl (A ,U ,C tA, — ETC — ) 

(C) = ((U|TRANSPOSE)^<A)*(U| + (C) BY CALL UTAUCKA,U,C,C, — ETC — ) . 

IF N IS NEGATIVE A SYMMETRIC (Z) IS COMPUTED. 

MAXIMUM SIZE N=500 

INNER PRODUCT SUMS ARE PERFORMED IN DOUBLE PRECISION. 

FORMA SUBROUTINE ZZECME IS CALLED. 

COOED BY JOHN ADMIRE *NA$A* AUG 1P72 . 

LAST REVISION BY RL WOHLEN. APRIL 1976. 

ARGUMENTS 

MATRIX CA) ♦DESTROYED* SIZE IN 

UPPER TRIANGULAR MATRIX (Ul SIZE IN 

MATRIX (C) SIZECN 

MATRIX fZ) SIZECN 

ABSCNI NUMBER OF ROWS AND CCLUmS INIA) t CU) » CC) AND CZ) 
ROW DIMENSION OF (A) IN CALLING PROGRAM 
ROW DIMENSION OF (U) IN CALLING PROGRAM 
ROW DIMENSION OF (C) IN CALLING PROGRAM 
ROW DIMENSION OF (Z) IN CALLING PROGRAM 

NERPOK EXPLANATIONS 
I = SIZE EXCEEDANCE. 

NN=IABSCN) 

NERROR = 1 

IFCNN .GT. 500 -OR. NN -GT. KRA .OR. NN -GT. KRU 
♦ .OR. NN .GT,. KRC .OR. NN .GT. KR2) GO TO 999 
DO 30 1=1 ,NN 
DO 10 K=1 ,NN 
10 VCK)=ACI,K) 

DO 30 J=1,NN 
SUM=2ER0 
DO 20 K=1,J 
SS=V(K)*U(K,J) 

20 SUM=SUM+SS 
30 ACItJ)=SUM 

IFCN .GT. O) GO TO 70 
DO 60 J = 1»NN 
DO 40 K=1,J 
40 VCK)=A(K,J) 

DO 60 I = I ,J 
SUM=C(I,J ) 


A 

- 

INPUT 

U 

- 

INPUT 

C 


INPUT 

z 


OUT PUT 

N 

- 

INPUT 

KRA 

— 

INPUT 

KRU 

— 

INPUT 

KRC 


INPifT 

KR2 


INPUT 


BY N) 
BY N) 
BY N) 
BY N| 
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DC 50 K=1,I 
SS=U(K*I)*V(KI 
50 SUM=SUM+SS 
60 Z(I,J)=?UM 
DO 63 1=1 ,NN 
DC 63 J=I,NN 
63 Z( J,I)=Z(1,J) 

RETURN 

70 DO 100 J=lfNN 
DO 80 K=1,NN 
80 V(K)=A(K,J) 

DO 100 1=1, NN 
SUM=CCI,J) 

DO RO K=1 ,I 
SS=U(K,n*VtK) 

90 SUM=SUM+SS 
100 Z(I,JI=SUM 
RETURN 

999 CALL Z2B0MBt6HUTAUCl,NERR0R) 
END 
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SUBROUTINE VCROSS (VA,VB« VZ« VAMAG«V6MAG« VZNAGtSINABl 
DIMENSION VAI3»*VB(3I ,VZ(3I 
C 

C VECTOR C3-DIMENSICNAU CROSS PRODUCT. (VAtCROSSf VB} = (VZI. 
C CODED BY RF HRUDA. OCTOBER 1966. 

C 

C SUBROUTINE ARGUMENTS 

C VA = INPUT VECTOR A. 

C VB = INPUT VECTOR B. 

C VZ = OUTPUT VECTOR Z. 

C VAMAG = OUTPUT MAGNITUDE OF VA. 

C VBMAG = OUTPUT MAGNITUDE OF VE. 

C VZMAG = OUTPUT MAGNITUDE OF VZ. 

C SINAB = OUTPUT SINE OF THE ANGLE BETWEEN VA AND VB. 

C 

VZm = VA<2I*VP(3I-VA(3I*VB(2I 
VZ(2I = VA<3)*VB(l)-VAa)»VBI3» 

VZ(3) = VA(lJ*VB(2»-VAC2l’»VBm 
C 

SA = 0.0 
SB = 0.0 
SZ = 0.0 
DO 10 1=1,3 
SA = SA + VA(I)**2 
SB = SB + VP(I)**2 
10 SZ = SZ + vzm^*2 
VAMAG = SCRTfSAl 
VBMAG = SC'PTISB) 

VZMAG = SORT(SZ) 

IF CVAMAG.lt. l.E-30 .OR. VBMAG-LT.l .E-301 GO TO 20 
SINAB = VZMAG/( VAMAG* VBMAG) 

IF (SINAB..GT.+1.0) SINAB = +1.0 
IF ( SINAB .LT.-l. 01 SINAB = -1.0 
RETURN 
C 

20 SINAB = 0. 

RETURN 

END 
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SUBROUTINE VDOT (VA«VB« PRODCT,VAMAG,VBMAG,COSAB) 
DIMENSION VA(3I»VB<3I 
C 

C VECTOR (3-niMFNSinNAL» DOT PRODUCT. (VA)DOTfVB) = PROOCT. 
C CODED BY RF HRUDA. OCTOBER 1968. 

C 

C SUBROUTINE ARGUMENTS 

C VA = INPUT VECTOR A. 

C VB = INPUT VECTOR B. 

C PROOCT = OUTPUT SCALAR PRODUCT OF (VAlDQT(VB). 

C VAMAG = OUTPUT MAGNITUDE OF VA. 

C VBMAG = OUTPUT MAGNITUDE OF VB. 

C COSAB = OUTPUT COSINE OF THE ANGLE BETWEEN VA AND VB. 

C 

SA = 0. 

SP = 0. 

PROOCT = 0. 

DO 10 1=1,3 
SA = SA + VA(II**2 
SB = SB ♦ VPm**2 
10 PROOCT = PROOCT ♦ VA(I)*VB(n 
VAMAG = SCRT(SA) 

VBMAG = SCRT(SB) 

IF IVAMAG.LT.l .E-30 .OR. VBMAG.LT.l .E-30) GO TO 20 
COSAP = PRCDCT/(VAMAG»VBMAG) 

IF <COSAB.GT.+1.0) COSAB = ♦! .0 
IF (COSAB. LT.~1.01 COSAB = -1.0 
RETURN 
C 

20 COSAB =0. 

RETURN 

END 
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SUBROUTINE VMl I XVEC* DIS *CON, AMP ,TOD.CONVRT,2 V,2M * 

♦ NX*NDtNC,NAfNTDO,KDIStKCCN,KAMP,KTDDl 
DIMENSION XVFCC 1 ) ,OIS (KDIS,1» ,CON tKCON, 1 1 ,AMP CKAMP, 1 1 ,TDD{KTDO, 1 J » 

♦ 2V(l).2Mtl) 

C 

C SUBROUTINE TO INTEGRATE PRESSURE OR WEIGHT DISTRIBUTION TO OBTAIN 
C SHEAR AND MOMENT AT A SET OF PRESCRIBED STATIONS fXVECJ. THE PRESSURE 
C OR WT DISTRIBUTION IS AMPLIFIED EY AN AMPLIFICATION DISTRIBUTION «AMPJ. 
C CONCENTRATED MASS ITEMS (CON) USE 2 AMPLIFICATION FUNCTIONS IN GENERAL* 
C AMP ALWAYS AND TDD -CTHETA DOUBLE OOTI- IN THE EVENT OF THERE BEING 
C A NON-2FRO DISTANCE EETWEEN ATTACH POINT AND CG. OR IE THERE IS LOCAL 
C CONCENTRATED INERTIA. IN ANY CASE, AMP AND TOfi MUST ALWAYS BE DEFINED 
C IFOR EXAMPLE - MAY BE UNITY OR 2ERO IN COLUMNS 3 AND 4). 

C NOTES... 

C 1) THE DISTRIBUTED DATA (D IS ,A. .• * AND TOO I MUST HAVE THEIR SEGMENT 
C LIMITS IN ASCENDING ORDER, THE SEGMENTS MUST NOT OVERLAP AND 

C MUST EE IN ASCENDING ORDER. 

C 21 ON ANY INTERVAL WHERE DISTRIBUTED DATA IS NOT DEFINED 
C (GAPS BETWEEN SEGMENTS!, THE VALUES ON THE INTERVAL ARE ASSUMED 

C TO BE 2FRO. 

C 3) THE CONCENTRATED ITEMS MAY BE SUPPLIED IN ANY ORDER (ROWWISE!. 

C CALLS FORMA SUBROUTINE 2ZEOME. 

C CODED BY CARL BODLEY. AUGUST 1966. 

C LAST REVISION BY WA BENFIELD. MARCH 1976. 

C 

C SUBROUTINE ARGUMENTS 

I XVEC = INPUT VECTOR OF STATIONS WHERE SHFAR AND MOMENT ARE DESIRED. 

^ SI2E(NX!. STATIONS MUST EE IN ASCENDING ORDER. 

DIS = INPUT MATRIX OF DISTRIBUTED WEIGHT (OR PRESSURE! STRAIGHT 

LINE SEGMENT DATA. SI2E(ND,4l. SEE NOTES 1,2. 

CGL 1 = X AT SEGMENT END I . 

COL 2 = X AT SEGMENT END 2. 

CCL 3 = WEIGHT AT SEGMENT END 1. 

COL 4 = WEIGHT AT SEGMENT END 2. 

CON = INPUT MATRIX OF CONCENTRATED ITEM DATA. SI2E(NC,4!< NOTE 3. 

COL 1 = ATTACH STATION OF ITEM. 

COL ^ = MASS OF ITEM. 

COL 3 = CENTER OF GRAVITY OF ITEM. 

CCL 4 = MOMENT OF INERTIA «60UT CG OF ITEM. 

AMP = INPUT MATRIX OF DISTRIBUTED AMPLIFICATION STRAIGHT LINE 

SEGMENT DATA. SIZE(NA,4!. SEE NOTES 1,2. 

COLUMNS ARE SIMILAR TO OIS. 

TDD = INPUT MATRIX OF SUPPLEMENTARY DISTRIBUTED AMPLIFICATION 

STRAIGHT LINE SEGMENT DATA. SIZE (NTOO,4! . NUTES 1,2. 
COLUMNS ARE SIMILAR TO DIS. 

CONVRT = INPUT CONVERSION SCALAR. (MULTIPLIES COL 3,4 OF OIS AND 

COL 2,4 OF CON!. 

2V = nUTPLa VECTOR OF SHEARS AT THE STATIONS XVEC. SIZE (NX!. 

ZM = OUTPUT VECTOR OF MOMENTS AT THE STATIONS XVEC. SITE(NX!. 

NX = INPUT SIZE OF VECTORS XVEC, ZV, AND ZM . 

ND = INPUT NUMBER OF SEGMENTS (ROWS! OF DIS. 

NC = INPUT NUMBER OF CONCENTRATED ITEMS, (ROWS OF CON!, 

i NA = INPUT NUMBER OF SEGMENTS (ROWS! OF AMP. 

C NTDO = INPUT NUMBER OF SEGMENTS (ROWS! PE TOO. 

C KDIS = INPUT ROW DIMENSION OF DIS IN CALLING PROGRAM. 
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C 

C 

C 

C 

C 

C 

C 

C 

c 

c 

c 

c 


KCON 

KAMP 

KTOD 


INPUT ROW DIMENSION OF CON IN CALLING PROGRAM. 
INPUT ROW DIMENSION OF AMP IN CALLING PROGRAM. 
INPUT ROW DIMENSION OF TDD IN CALLING PROGRAM. 


NERRCR EXPLANATION 


1 = NON-POSITIVE SI2ES. 


2 

=r 

STATIONS NOT IN 

1 ASCENDING ORDER 

3 

= 

INCORRECT 

DATA 

IN 

MATRIX 

AMP. 

4 


INCORRECT 

DATA 

IN 

MATRIX 

AHP- 

5 


INCORRECT 

DATA 

IN 

MATRIX 

TDD. 

6 

= 

INCORRECT 

DATA 

IN 

MATRIX 

TDD. 

7 


INCORRECT 

DATA 

IN 

MATRIX 

DIS. 

8 


INCORRECT 

DATA 

IN 

MATRIX 

DIS. 


10 


40 

47 


30 

48 


35 

49 


20 


DO 10 K-1 rNX 
ZV(K) = 0.0 
ZM»K) = 0.0 

NERR0R=1 

IF (NX .LF. 0 .OR. NA .LE. 0 .OR. NTDD .LE. 0) GO TO 999 
IF (NX .EC. II GO TO 47 

NERR0R=2 

LC 40 1=2 .NX 
K = I - 1 

IF (XVFC(KI .GE. XVEC(II) GO TO 999 
CONTINUE 


IF (AMP(l.l) .GF. AMP(1,2I) GO TO 999 
IF (NA .EC'. 1) GO TO 48 
NAMl = NA - 1 


DO 30 1=1 ,NAM1 
K = I + 1 

IF (AMP(I,2) .GT. AMP(K.l) .OR. AMP(K.l) 
CONTINUE 

IF (TDDd.n .GE. TDD(1,2)I GO TO 999 
IF (NTDD -’.FQ. 1) GO TO 49 
NTMl = NTDD - 1 

DC 35 1 = 1, NTMl 
K = I ♦ 1 

IF (T0n(I,2I .GT. TDD(K.l) .OR. TD0(K,1! 
CONTINUE 

IF (ND .EC. 0) GO TO 85 

IF (DlSd.n .GF. DIS(1,2M GO TO 999 
IF (ND .FC. 1) GO TO 51 
NDMl = ND - 1 


DO 20 1=1 .NDMl 
K = I ♦ 1 

IF (0ISd,2) .GT. DIS(K.l) .OR. DIS(K,1I 
CONTINUF 


NERR0R=3 

NERR0R=4 

.GE. AMPCK.21) GO TO 999 
NERR0R=5 

NEKR0R=6 

.GE. TDD(K,2I) GO TO 999 
NERR0R=7 

NERR0R=8 

.GE. DIS(K,2)) GO TO 999 


DISTRIBUTED DATA. 
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51 I = 1 
J = 1 
K = 1 
VI 0.0 
GI = 0-0 
XIMl = XVECfl) 

IF (XlMl -GT. DIS(1,D) XIMl = OlSUvll 
IF (XIMl .GT. AMP(Jyl)) XIMl - AMP(J«I) 

C 

50 XI = XVEC(K» 

IF (XI .GT. DIS(I,2I .and. DIS(1»2I -GT. XIMII XI = 0IS(I,2) 

IF (XI -GT. DIS(I,1) -AND. DISdtD -GT- XIMII XI = DIS(I«1| 

IF (XI -GT. AMP(J,2) -AND. AMP(J»2I -GT. XIMl) XI = AMP(J«2) 

IF (XI -GT. AMP(J,1) -AND. AMP(J,1) -GT. XIMII XI = AMP(J*I) 

F = ((0IS(I,4|-0IS(I,3II/(DIS(I,2I-DIS(I,1III»C0NVRT 
E = C0NVRT*DIS(I,3I - F»DIS(I,1I 
H = (AMP( J,4)-AMP(J,3ll/(AMP(Jf2l-AMP(J,lll 
G = AMP(J,3) - H*AMP(J,1I 
OX = XI - XIMl 
A = 0.0 
B = 0.0 
C = 0-0 
D = 0.0 


IF 

(DlSdtl) 

-LE. 

XIMl 

.AND. DIS(I,2I 

-GE. 

XII 

A=E^F»XIM1 

IF 

(DISCI, 1) 

.LE. 

XlMl 

.AND. DIS(I,2) 

.GE. 

XII 

B=F4DX 

IF 

(AMP(J,1) 

.LE. 

XIMl 

.AND. AMP(J,2) 

• GE. 

XI 1 

C=G+H^X1M1 

IF 

(AMP(J,1) 

.LE. 

XIMl 

-AND- AMP(J,2I 

.GE. 

XI 1 

D=H*DX 


GI = GI+VI4DX-K)X4^24( a»C/ 2-+(A»0+B*CI/6. ♦B*0/12.l 
VI = VI ♦ 0X=MA»C ♦ (A»0 ♦ B»C|/2. ♦ B*0/3.l 


ZV(K) = 

VI 





ZM(K) = 

GI 





IF (XI 

-EC. 

XVEC(NX II 

GO TO 85 



IF (XI 

-EG. 

XVEC(K) I 

K=K+1 



IF (XI 

.EG. 

DIS(1,2 I 

.AND. I-d .LE. NDI 

I = 

H^l 

IF (XI 

.EQ. 

AMP( J,2I 

.AND. J4^1 .LE. NA) 

J = 

J+1 


XIMl ^ XI 

GO TO 50 

COMCENTRATFD MASS ITEMS. 

85 IF (Nt -EO. 0) RETURN 
DO 102 1=1 »NC 
DO 90 J=1 fNX 

IF (XVEC(J) -GE. CON(I,in GO TO 95 
90 CONTINUE 
GO TO 102 
95 DO 115 M=1,NA 

IF IC0N(I,1) .LE. AMP(M«2I) GO TO 120 
115 CONTINUE 
M = NA 

120 VT = AMP(M,3l+(C0N(I,l|-AMP(M*ll)4(AMP(M,4|-AMP(M,3ll/ 

♦ (AMP (Mt2 »-AMP(Mf 1 1 1 

IF (CON'ltl) -LT. AMP(M«1) .OR. CON(I.l) .GT. AMP(M,2I) VT = 0. 
IF (CON(Itl) .FQ. C0N(It3) -AND. C0N(I,41 .EQ. O.Ol GO TO 105 
DO 125 N=1,NTDD 

IF (CONdtll .LE. TDD(N,2)I GO TO 130 
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125 COMTIWUF 
N = NTDD 

130 VR = Tnn(N,31^<C0N(I,ll-TDDtN,in*CTDDfN,4|-T0DCN,3l)/ 

* «TDP<N,2)-TDD(N,in 

IF (CONCI.l) .LT. TDD(Ntll *0R. C0NCI,1» .GT. T0D(N,21) VR = 0- 
105 VVS = C0NCI,2)*«VT ♦ (C0N(I«1) - CONf ItSH^VR )’>CONVRT 
VMS = CON(I,4)»VR*CONVRT 
DO 100 K=J,NX 
2V(K) = ZV(K) ♦ VVS 

100 ZM(K) = ZM(K» ♦ VMS ♦ (XVEClKI “ CONC I, 31 l+VVS 
102 CONTINUE 
RETURN 

999 CALL ZZBOMB I6HVM1 ,NERROR) 

END 
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SUBPCUTINE VMTFl ( PP ,Z tNPP ,NZtKZ ) 

DIMENSION PP(l)f KKZfll 

GENERATE TRANSFORMATION MATRIX TO GIVE SHEARS AND BENDING MOMENTS IN 
TERMS OF FORCES AND MOMENTS. 

CALLS FORMA SUBROUTINE ZZBOMB. 

CODED BY C BODLFY. JULY 1965. 

LAST REVISION BY WA BENFIELD. MARCH 1976. 

SUBROUTINE ARGUMENTS 

PP = INPUT VECTOR OF PANEL POINT STATIONS. SIZEJNPP). 

2 = OUTPUT SHEAR, MOMENT TRANSFORMATION. SIZE (2*NPP ,2*NPP) . 

NPP = INPUT NUMBER OF PANEL POINTS. 

NZ = OUTPUT SIZE OF SHEAR,MOMENT TRANSFORMATION. (NZ=2*NPP). 

KZ = INPUT ROW DIMENSION OF Z IN CALLING PROGRAM. 


NEPROR EXPLANATION 

1 = LESS THAN 2 PANEL POINTS. 

2 = PANEL POINTS NOT IN INCREASING ORDER. 


IF (NPP .LT. 2) GO TO 999 
DO 5 1=2, NPP 

IF (PP(I-n .GE. PP(IH GO TO 999 
5 CONTINUE 


NERROR=l 

NERROR=2 


NZ=2*NPP 
DO 10 1 = 1 ,NZ 
DO 10 J=1,NZ 
10 Z(I,JI = 0. 

DO 25 1=1, NPP 
K=I+NPP 
DO 25 J=1 ,I 
L= J + NPP 
Z(I,J)=1.0 
Z(K,LJ = 1 ,0 

25 Z(K,J)=PP(I)-PPIJ) 

RETURN 

999 CALL ZZBOMB (6HVMTR1 ,NERROR) 
END 
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SUBROUTINr WRITAN ( lA tNRf NC tANAKE,KRI 
DIMENSION IA(KR»1I 
COMMON /LLINE /NL INE»MAXLIN,MINI 
DATA NlT,N0T/f,,6/ 

C 

C WRITE MATRIX CE ALPH A-NUMFRIC CHARACTERS (A6) ON PAPER, 

C REQUIRES 132 COLUMN (MINIMUM) PRINTER. 

C UP TO 20 DATA FIELDS PER LINE. PRINTS ONLY NON-BLANK FIELD ROWS. 
C CALLS EORMA SUBROUTINE PAGEHD- 
C COOED BY JOHN ADMIRE *nAS» OCT 1974. 

C 

C SUBROUTINE ARGUMENTS (ALL INPUT) 

C IA = MATRIX TO BE PRINTED. SIZE(NR,NC). 

C NR = NfMPSP CE ROWS IN MATRIX I A. 

C NC = NUMBER OF COLS IN MATRIX lA. 

C ANAME = MATRIX IDENTIFICATION. ( A6 FORMAT). 

C KR = ROW DIMENSION OF IA IN CALLING PROGRAM. 

C 

2010 FORMAT (//15H OUTPUT MATRIX A6,2X 1HI"4,2H X I4t2H ) // 

* 12X,20(1X»1H( I2,1H)1X)/) 

2020 FORMAT (//15H OUTPUT MATRIX A6.2X 1H(I4,?H X 14, 2H ) 

* 3X, 9HC0N1INUEU //I 2X ,20( IX , 1H( I2,lH),lX)/) 

2030 FORMAT ( 1 X , 2IA ,3X ,2uA 6) 

2040 FORMAT (IBHCEND OT WRITAN.) 

2050 FORMAT ( /1X13I ( IH ~) ) 

C 

CHECK IF NEW PAGE NEEDED 
C 

IF (MINI .NE. 4HMINI) GO TO IC 

1F(NLINE .LE. 5 .OR. NLINE .GE. MAXLIN) GO TO 10 
NBC=NC/20 

1F(NBC*20 .NE. NC ) NBC=NBC+1 
NNL=10+NR 

IF (NBC .GT. 1) NNL= 9+NR»(NBC+l) 

1F(NNL+NLINE .GT. MAXLIN) GO TO 10 
WRITE (NOT, 2050) 

NLINE=NIINE^2 
GO TO 20 
10 CALL PAGE HD 
C 

C WRITE MATRIX 

C 

20 WRITE(N0T,?010) ANAME ,NR,NC , ( L,L=1 , 20 ) 

NLINE=NLINE-*-6 
DO 90 1=1, NR 

NZFR0=0 
JS=1 

30 JE=JS+19 

JF(JE .GT. NC) JE=NC 
DO 40 J=JS,JF 

40 IF(IA(I,J) .NE. 6H ) GO TO 50 

GO TO 70 
50 NLINE=NLINE+1 

IE(NLINF ,LE. MAXLIN) GO TO 60 
call PAGEHD 
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WRITE (NOT, 20201 ANAME,NR ,NC, ,201 
NLINE=NLINf +6 

<►0 WRITE (NOT, 2030) I , JS , ( lA ( I ,J ) , J=^JS , JE) 

NZER0=1 

70 IF(JE .FC. NO GO TD 80 
JS=JS+?0 
GO TO 30 

80 IF(NC .LE.20 ,0R. NZERO.EG. O .OR. I .EO. NR) GO TO 90 

NLINE=NLINE+1 
WRITE (NOT, 2030) 

90 CONTINUE 

WRITE (NOT, 2040) 

NLlNE=NLINE+2 

RETURN 

END 
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SUBROUTINE WRITE { A, NR tNC, AN AME ,KR ) 

DIMENSION A(KR,1| 

COMMON /LLINE /NL INE, HAXL IN ,M INI 
DATA NIT, NOT/5, 6/ 

C 

C WRITE MATRIX OF REAL NUMBERS ON PAPER. 

C REOUIPFS 123 COLUMN (MINIMUM) PRINTER. 

C UP TO 10 DATA FIELDS PER LINE. PRINTS ONLY NON-ZERO FIELD ROWS. 
C CALLS FORMA SUBROUTINE PAGEHD. 

C CODED BY RL WOHLEN. OECEMfiER 196P. 

C MODIFIED BY JOHN ADMIRE ♦NASA* SEPT 1973 
C 

C SUBROUTINE ARGUMENTS (ALL INPUT) 

C A = MATRIX TO PE PRINTED. SI2E(NR,NC). 

C NR = NUMBER OF ROWS IN MATRIX A. 

C NC = NUMBER OF COLS IN MATRIX A. 

C ANAME = MATRIX IDENTIFICATION. ( A6 FORMAT). 

C KR = ROW DIMENSION OF A IN CALLING PROGRAM. 

C 

2010 FORMAT (//15H OUTPUT MATRIX A6,2X 1H(I4,2H X I4,2H ) // 

* 10X,10(7X,1H( 12, IH))/) 

2020 FORMAT (//15H OUTPUT MATRIX A6,?X 1H(I4,?H X 14, 2H ) 

♦ 3X, 9HC0NT1NUED //I OX ,10 ( 7X ,IH( 12, IH))/) 

2030 FORMAT ( 1 X , 21 5 , 2X , 1 PI OE 1 1 .4 ) 

2040 FORMAT (lAHOEND OF WRITE.) 

2050 FORMAT (/1X123( 1H~) ) 

CHECK IF NEW PAGE NtEDED 

ib(mini .ne. ahmini) go to 10 

IF(NLINF .LE. 5 .OR. NLINE .GE. MAXLIN) GO TO 10 
NBC-NC/10 

1F(NBC*10 .NE. NC) NBC=NBC+1 
NNL=10+NR 

IF(NBC .GT. 1) NNL= 9+NR*(NPC+l) 

IF(NNL+NLINE .GT. MAXLIN) GO TO 10 
WRITF(NCT,2050) 

NLINE=NLlNE+2 
GO TO 20 
10 CALL PAGEHD 

WRITE MATRIX 

20 WR:TF(NOT,?01C) ANAME,NR,NC,(L,L=1,10) 

NLINE=NL INF+6 
DO 90 1=1, NR 

N2ERn=u 
JS = 1 

30 JF=JS+9 

IF(JE .GT. NC) JE=NC 
DO 40 J=J‘,JF 

40 IE(APS( A( 1,J) ) .GT. 0.) GO TO 50 
GO TO 70 
50 NLINF=NL1NF+1 

IE(NL1NC .LE. MAXLIN) GO TO 60 
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CALL PAGFHO 

WRITE <NOT, 20201 ANAMEfNRfNCt (Lt L=? t 101 
NLINE=NLINE +6 

60 WRITE (NOT, 20301 I , JS , ( A( I, J) , J=JS, JE } 

NZER0=1 

70 IF(JE .FQ. NO GO TO 80 
JS=JS+1C 
GO TO 30 

80 IF(NC .LF.IO .OR. N2ER0.E0. 0 .OR. I .EC. NR) GO TO 90 
Nl INE=NLINE+1 
WRITE J>0T,2030) 

90 CONTINUF 

WRITE (MOT, 2040) 

NLINF=NLlNE+2 

RETURN 

END 
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SUPPCUTIK t WRITIM ( lA tNR.NC t AN'AME ,KR| 

DIMtNSI -N 1A(KR,1) 

COMMON /LLINE /NLlNttMArLlN.MINI 
DATA NIT, NOT/ 5, 6/ 

C 

C WRITE matrix of INTEGER NUMPERS CN PAPER. 

C REQUIRES 116 COLUMN (NTNIMUMJ PRINTER. 

C UP TO 20 DATA FIELDS PER LINE. PRINTS ONLY NC5N-ZER0 FIELD ROWS. 
C CALLS FORMA SUFROUTINE PAGEHD. 

C CODED EC PL WGHLEN. JULY 1<»68. 

C MODIFIED G'f JOHN ADMIRE ♦NASA* SEPT 1973 
C 

C SUBROUTINE ARGUMENTS (ALL INPUT) 

C lA = matrix TP BE PRINTED. SIZE(NR,NC). 

C NR = N'JMPEF OF ROWS IN MATRIX I A. 

C NC = NUMBER 0^ COLS IN MATRIX I A. 

C ANAMS = MATRIX IDENTIFICATION. I A6 FORMAT). 

C KR ROW DIMENSION OF lA IN CALLING PROGRAM, 

u 

2010 FORMAT t//lEH CV^«*UT MATRIX A6.2X 1H(IA-,2H X 14, 2M ) // 

* 16 X, 20 n ( 12, IH' )/) 

2020 FORMAT i MATRIX A6,2X 1H(I4,2H X I^,2H ) 

♦ 3X, OHCONTINUED //loX ,20( IX ,1H( I2,1H)1/I 
2030 FORMAT (1 X, 2I5,5X,2GI IS) 

20A^0 format nSHOENC CF WRITIM.) 

2050 FORMAT (/1XM6UH-)) 

i* 

1; CHECK IF NEW PAGE NEEDED 

C 

IF (MIN I .NE. 4HMINI) GO TO 10 

1F(NLINE .LE. 5 .OR. NLiNE .GE. MAXLIN) GO TO 10 
NBC=NC/?0 

IF(NFC*2G .NF. NC ) NEC-NBC-H 
NNL=10+NR 

IF (NBC .GT. 1) NNL= 9*NR*(N6C+1) 

IF(NNL+NL1NF .GT. MAXLIN) GO TO 10 
WRITE (NOT ,?CEO) 

NLlNt-NuINE+2 
CO TO 2C 
10 CALL PAGEHD 

WRITE MATRIX 

20 WRITE (NOT ,2010) ANAME ,Nh ,NC , ( L,L=1 , 20 ) 

N> INE=NLINF+6 
01 RO I=1,NR 
N2ERC=0 
JS=1 

30 JE=JS+19 

IF(jr .r-T. E., JE=NC 
DO ^0 J-JS,JE 

40 IF(IA(I,J) .NE. 0) GO .u 50 
GO TP 70 
50 NLINE =NLINE+1 

IFINLINE .LE. MAXLIN) '• TO 60 
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CALL PaGFHP 

WRITF IN'CT,2020) ANAME,NR ,NC, IL,L=1 ,201 
NLlNF=NLINF+6 

60 WRITE (NCT,2030) I , JS ,( 1A( I ,J } ,J=JS, JE} 

N2EPP=1 

70 IF(JF .FC. NO GO TO 80 
JS=JS-t20 
GO TO 30 

80 IF(NC .LF.20 .OR. NZERO.EO. 0 .OR. I .Ft. NR I GO TO 90 
NLINF- .INE+1 
WRITE (NOT, 2030) 

90 CONTINUE 

WRITF (NOT, 20401 

NLINF=NLINE+2 

RETURN 

END 
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SUBRCU IN'E WTAPE < AtNRA*NCA, ANAME ,KR tNTAPE ) 

DIMENSION A(KR,1| 

COMMON /L START/I RUNNO ,D ATE , NP AGE ,UN AME( 3 1 • TITLE 1( 12 1 ,TITLE2 < 12 1 
DATA BUE^EOTt DENS E/0., 3HEOT,5HDENSE/ 

WRITE MATRIX A ON TAPE. 

INITIALIZE tape WITH SUBROUTINE INTAPE. 

REWIND TAPE EEFOPE FIRST USE OF THIS SUBROUTINE. 

NOTE. ..THIS ROUT? ;e IS DESIGNED SPECIFICALLY FOR WRITING ON A DISK 

(EG CDC-o OO DISKI. UoING THIS ROUTINE TO WRITE ON A PHYSICAL 
TAPE DIPEC^LY I IE WITHOUT USING THE DISK AS AN INTERMEDIARY! 
WILL PPOBALLY GIVE POOR RESULTS (DUE TO THE TOLERANCE 
CHARACTERISTICS OF A TAPE DRIVE I AND SHOULD BE AVOIDED IF AT 
AIL POSSIBLE. 

CALLS FORMA SURROUTINF ZZBOMB. 

CODED BY W A PENFIELD. MARCH 1966. 

REVISED BY PF HRUDA. NOVEMBER 1970. 

MODIFIED FOR CONTRACT NAS8-2f>922, MAY 1971. 

SUPROUTIN? ARGUMENTS (ALL INPUT) 

A = MATRIX TO PF WRITTEN CN TAPE. SIZE (NRA,NCAl . 

NRA = NUMFEP ROWS OF MATRIX A. 

NCA = NUMFFR OF CC‘i.5 OF MATRIX A. 

ANAME = MATRIX I0ENT1FICAT1(?N . (A6 FORMAT). 

KR = ROW DIMENSION OF A IN CALLING PROGRAM. 

NTAPE = NUMBER OF TAPE. (E.G. 10). 

NEPROP EXPLANATION 
1 = NON-POSITIVE ROW OR COLUMN SIZE. 

INTERNAL VARIAPLES THAT ARE PUT ON TAPE (TRANSFERRED THRU COMMON). 
IRUNNC IS RUN NUMBER OF PROBLEM. (A6 FORMAT). 

DATE IS DATE. (A6 FORMAT). FOR EXAMPLE 15FE65. 


NERROR = 1 

IF (NRA .LT. 1 .OK. NCA .LT. 1) GO TO 999 

SEARCH TAPF FOR END OF WRITTEN DATA. 

10 READ (NTAPE) TAPE ID ,LN, lECTCK 
IF (IFOTCK .FQ. 3HE0T ) GO TO 20 
READ (NTAPE) 

GO TO 1C 

END OF WRITTEN DATA HAS BEEN T-CUND. 

20 BACKSPACE NT^p^ 

WRITE (NTAPE) TAPE ID, LN ,BUE , IPUNNO, ANAME, NRA, NCA, DATE tDENSE , 

* (FUF,!=1,10) 

WRITE (NT. ) ((A(1,J),I=1,K'RA),J = 1,NCA) 

LN = LN 

WRITE (NTAPE) TAPEID, LN ,EOT, ( PUF , 1= 1 , 16 ) 

ENOFILE NTAPE 
REWIND NTAPE 
NREC = 2 * (LN-1) 

DO 30 IREC=1,NREC 
30 READ (NTAPE) 
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RETURN 

999 CALL 22BCMB (6HWTAPE tNERRGRI 
END 
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SUBROUTINE XLORD ( V«LV*LAS*NNZA I 

DIMENSION V(UtLV(ll»W(256}«LWf256}»IU(l6)«IL<16) 

DATA MT,NCT/5,6/ 
data LWDIM/256/ 

ARRANGE ELEMENT LOGATIONS (LV» INTO INCREASING ORDER, 

REARRANG‘D ELEMENTS <V» ACCORDINGLY. 

DEVELOPED BY R A PHILIPPUS. OCTOBER 1%8. 

LAST REVISION BY WA 6ENFIELD. MARCH 1976. 

SUBROUTINE ARGUMENTS 

V = INPUT VECTOR. A ELEMENTS. ♦DESTROYED* 

= OUTPUT VECTOR. A ELEMENTS. (ARRANGED) 

LV = INPU. VECTOR. ELEMENT LOCATIONS OF A. ♦DESTROYED* 

= OUTPUT VECTOR. ELEMENT LOCATIONS OF A. (ARRANGED) 

LAS = INPUT START LOCATION OF A IN V. 

NNZA = INPUT NUMBER OF NON-ZEROS IN A. 

NERROR EXPLANATION 

1 = TWO LIKE LOCATION NUMBERS ENCOUNTERED. 

2 = TWO LIKE LOCATION NUMBIRS ENCOUNTERED. 

3 = TWO LIKE LOCATION NUMBERS ENCOUNTERED. 

3001 FORMAT (50H1TW0 LIKE LCCATIGN NUMBERS ENCOUNTERED IN XLORD ATIll/) 
3003 FORMAT (5 ( 1 12 , E12 .3 ) ) 

IF (NNZA.LE .1 ) RETURN 
LAF=LAS-1+NNZA 
LAEM1=LAE-1 
NSEG^l 

QUICK SEARCH FOR 1 OR 2 SEGMENTS. 

NERRDR=1 

DO 5 I-LAS»LAEM1 
IF (LV( I ) .LT.LV( I+l )) GO TO 5 
IF (LV( n .F£.LV(I+D) GC TO 990 
NSEG=NSEG-^1 
IA=I 

IF (NSEG.GT.2) GO TO 6 
5 CONTINUE 

IF (NSFG.EO.l) RETURN 
NNZS=IA-LAS+1 

CHOOSE BZ-TWEEN MESH AND SINGLETON METHODS 
FNN2A = NNZA 
FNNZS = NN2S 
X = FYNZS/ENNZA 

DESCID = 60O0./(FNNZA + 1420.) 

IF (X .GT. DESCID) GC TO 6 
C 

C MESHING METHOD 

LBS = LAS 
LBE=LBr-l +NNZS 
LCS=LBF-»1 
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tXF = LAE 
IB=LBS 
IC=LCS 
IW=0 

IZ=LBS-1 

50 NERR0R=2 

IF (LV(I6)-LV(ICn 65,992,55 
55 IW=IW4^1 

W(IW)=V(IC» 

LWCIW|=LVtICI 

IC=IC^^1 

NN=1 

IF (IW.EQ.LWOIM) GC TO 95 
60 IF nC.GT.LCE) GG TO 75 
GO TO 50 
65 1W=IW+1 

W(lW|=V(iei 

LW(IWI=LV(IBI 

IP = IP4-1 

NN=2 

IF CIW.EQ.LWDIM) GO TO 95 
70 IF (1B.GT.LBE> GO TO 85 
GO TO 50 

75 NEtTM=LBE-IB+l 
I=IC-1 

DO 80 J-=1,NELTM 
V(I)=V(LPF» 

LV(n=LVlLBEI 
LBE=LBF-1 
80 1=1-1 

85 IF (IW.FL.C) RETURN 
DO PO 1=1, IW 
IZ=I2+1 

v(iz)=w(n 

90 LV(IZ)=LW(1) 

RETURN 

95 NELTM=LBE-1B+1 
I=IC-1 

DO 100 J=1,NELTM 
V(I)=V(LBEI 
LV( I)=LV(LBE) 

LRE=LRE-1 
100 1 = 1-1 

1P=IF+I-LEE 

LBE=1C-1 

DO 105 I=1,LWDIM 

IZ=I2+1 

VdZ )=v;(l) 

105 LV(TZI=LW(I) 

IW=0 

GC TO (60,70),NN 
r 

SINGLETON METHOD 
C 


6 M = 1 
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I = LA< 

J=LAS-1+NNZA 
7 IF(l.GE.J) GO 7C 170 
110 K = I 

IJ=(J+I )/2 
IT=LVIIJ) 

IF(LVin.LF.lT) GO TO 120 
LV<IJ) = LV(n 
LV(1 )=IT 
IT=LV(IJ) 

TG=V(IJ) 

v(ij)=vm 

V(I)=TG 
120 L=J 

IF(LV( J).GF.IT) GO TO l40 
LV( IJ)=LV(J) 

LV< J)=IT 
1T=I.V(IJ) 

TG=V(IJ) 

V{1J)=V(J) 

J)=TG 

F(LV(I).LE.IT) GO TO lAO 
LV(IJ) = LVm 
LV(I)=1T 
IT=LV(IJ J 
TG=V(IJ) 

V( IJ)=V( I } 

V ( n =TG 
GO TO 140 
130 LV(L)=LV(K) 

LV(K)=ITT 

TG=V(L) 

V(L 1=V(K» 

V(K)=TG 
140 L=L-1 

IF(LV(L).GT.IT) GO TO 140 
ITT=LV(L) 

150 K=K+1 

lF(LV(K).Lf .IT) GO TO 150 
IF(K.LE.L) GO TO 130 
IF(L-I.LE .J-K) TO 160 
IL(M)=I 
1U(M)=L 
I=K 
M = M + 1 
GO TO IRO 
160 IHM)=K 
IU(M)=J 
J=L 
M = M + ] 

GO Tt ICC 
170 M=M-1 

IF(M.EG.O) GO TO 210 
I-IL (M) 

J=TU(M) 
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180 IF(J-T.GE.ll) GO TO 110 
IF(l.EC.LAS) GO TO 7 
1 = 1-1 
190 1=1+1 

IF(l.EQ.J) GO TO 170 
IT=LV(I+1 ) 

IFUVf D.LE.IT) GO TO 190 
TG=V{I + n 
K = 1 

200 LVtK+1 )=LV(K) 

V(K+n = V(K) 

K=K-1 

IFdT.LT.LV(K)) GO TO 200 
LV(K+1 )=IT 
V(K+1)=TG 
GO TO 190 

210 DO 215 I=LAS,LAEM1 

NERR0R=3 

IF (LVm .EC.LV(I+1)I GO TO 990 
215 CONTTVUE 
RETURN 

ERROR STATEMENTS 
990 WRITE (NPTt3001) LV(I) 

GO TO 995 

992 WRITE (NDT*3001) LV(IB) 

995 WRITE (NOT, 3003) ( LV( L) ,V ( L ) , L=LAS , LAE ) 

CALL ZZbOMb {5HXL0RD ,NERROR) 

END 
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SUBROUTINE ZERO <Z,NR,NC,KR) 

DIMENSION 2{KR,I) 

GENERATE A MATRIX OF ZEROES. 

CODED BY RL UCHLEN, FEB 1965. 

SUBROUTINE ARGUMENTS 

2 = OUTPUT MATRIX GENERATED. SIZE(NR,NC>. 

NR = INPUT NUMBER OF ROWS IN MATRIX Z. 

NC = INPUT NUMBER OF COLS IN MATRIX Z. 

KR = INPUT ROW DIMENSION OF MATRIX Z IN CALLING PROGRAM. 

DO 10 I-1,NR 
DO 10 J=1,NC 
10 Z(I*J) = 0.0 
RETURN 
END 
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SUBROUTINE ZFROLH tA,NfKR) 

DIMENSION A(KRtl) 

SET LOWER HALF OF SQUARE MATRIX TO ZERO. 

CODED BY RF HRUDA. FEB 1965. 

SUBROUTINE ARGUMENTS 

A = INPUT, OUTPUT SUPPLIED AND RESULT MATRIX. SIZE(N,N1. 
N = INPUT SIZE OF MATRIX A CSClUARE). 

KR - INPUT ROW DIMENSION OF A IN CALLING PROGRAM. 

DO 10 1=2 ,N 
IMl = I-l 
DO 10 J=1,IM1 
10 A(1,J) = 0.0 
RETURN 
END 
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SUBROUTINE ZFRDUH (A,N,KR) 

DIMENSION A(KR,1) 

SET UPPER HALF CF SQUARE MATRIX A TO ZERO. 

CODED BY RF HPUDA. FEB 1965. 

SUBROUTINE ARGUMENTS 

A = INPUT, OUTPUT SUPPLIED AND RESULT MATRIX. SI2E(N,N). 
N = INPUT SIZE OF MATRIX A (SQUARE). 

KR = INPUT ROW DIMENSION OF A IN CALLING PROGRAM. 

DO 10 J=2,N 
JMl = J-1 
DO 10 I-1,JM1 
10 A(I,J) = 0.0 
RETURN 
END 
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SUBRnUTINP ZZBOMB(SUBNAM,NtRROR) 

DATA NITtNOT/5,6/ 

C 

ZZBOMB IS CALLFD WHFN AN ERROR HAS BEEN ENCOUNTERED 
IN A MAIN PROGRAM OR SUBROUTINE. 

ZZBOMB PERFORMS THE FOLLOWING 

(11 PRINTS THE PROGRAM NAME AND ERROR NUMBER WH. <E 
ERROR OCCURRED. 

(?) A WALK BACK IS PRODUCED 
(3) A DUMP IS PRODUCED 
{^) PROGRAM IS TERMINATED 
CODED BY JOHN ADMIRE *NASA» AUG 1972. 

MODIFIED BY JOHN ADMIRE *NASa* DEC 1975 

ARGUMENTS 

SUhNAM - INPUT SUBROUTINE NA*E WHERE ERROR OCCURRED. 

NERROH - INPUT ERROR NUMBER FROM SUBROUTINE WHERE ERROR OCCURRED- 

3001 FORMAT (20H1 STOP IN SUBROUTINE A6, 13H AT NERROR 13) 

C 

WRITE(N0T,300i) SUBNAM, NERROR 
C 

CALL STPACE 
CALL DUMP 
STOP 
END 



